[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『担当別に自動振り分け』（アイル）
ご教授願います。 エクセル2003使用です。
シートが「入力」「担当無」「鈴木」「佐藤」「山田」…とあります。
元のデータを「入力」シートに入力後。各担当に自動で振分けられるようにしたいです。
元データとなる「入力」シート
A B C D E F G H 4 NO 担当名 会社名 住所 商品名 数量 日付 金額 5 1 鈴木 A社 千葉 ペン赤 10 10/20 1000円 6 2 担当無 B社 東京 ノート 20 10/21 2000円
振分け先となる「担当無」「鈴木」「佐藤」「山田」…シート
A B C D E F G H I 4 NO 会社名 住所 商品名 数量 日付 金額 結果 備考
となります。
うまく説明できないのですが
(１)見出し等を付けたい為A1〜3は空欄、A4は項目名にしたいです。セルの列・行幅も全シート同じにしたいです。
(２)各担当が振分けされた「担当無」シートからやりたい案件を選択する
↓
選択後、選択した担当のシートに反映される
↓
選択された「担当無」シートにあるデータは削除、または選択した担当の名前が入るよ うにしたい
(３)振り分け先シートのみにある”H列の結果”と”I列の備考”は各担当が入力するためデータ振り分けを実行したら下端のセルに自動でデータが追加されるようにしたいと思っています。
(４)マクロ更新時データが重複しないよう(3）を踏まえた上で担当がH列とI列を入力していても重複を検索してHとIが未記入の行を削除したい
また上記作成後は共有ブックにし、同時に作業ができるようにしたいのですが可能でしょうか？
同じような質問などを参考にし色々試したもののマクロ、数式ともに勉強始めたばかりのレベルなので応用ができずエラーばかりなってしまいます。
長く解り辛い説明な上図々しいとは思いますが、ご教示いただければ幸いです。
宜しくお願い致します。
このあたりが参考にならないでしょうか。 [[20110301184111]] (Mook)
色々なマクロを参考にさせていただきましたが一番私がやりたい形を実現してくれました！！
しかし(3)が出来できずマクロを応用させていただく事も出来ませんでした…ご教授いただけませんでしょうか？
「入力」シートに
A B C D E … 4 NO 担当 会社名 住所 商品名 … 5 1 鈴木 A社 千葉 ペン赤 … 6 2 担当無 B社 東京 ノート … 7 3 鈴木 C社 埼玉 消しゴム …
↓振分け後 「鈴木」シート ※HとI列は振分け後、鈴木が自分で入力 A B C D E … H I 4 NO 担当 会社名 住所 商品名… 結果 備考 5 1 鈴木 A社 千葉 ペン赤… ○ 頑張った 6 3 鈴木 C社 埼玉 消しゴム…× 残念
「担当無」シート
A B C D E … 4 NO 担当 会社名 住所 商品名 … 5 2 担当無 B社 東京 ノート …
以上のようになり「担当無」シートを見た鈴木がB社も自分がやりたいと思い「入力」シートの担当無を鈴木に変更し振分けを実行すると「鈴木」シートが
A B C D E … 4 NO 担当 会社名 住所 商品名…結果 備考 1 鈴木 A社 千葉 ペン赤… 2 鈴木 B社 東京 ノート… 3 鈴木 C社 埼玉 消しゴム…
となってしまいA社とC社にB社が挿入されてしまい、結果と備考は消えてしまいます。
何か解決策はございますでしょか？
何度も頼りにしてしまって申し訳ありません…
ごめんなさい。 質問文の最初の部分しか見ていませんでした。
シートを特定列で振り分けるだけのマクロなので、他の機能は別途どうするかを 考えないといけないですね。
振り分けた後、元データと二つデータが存在するわけですが、マスターとしての 管理はどうでするのでしょうか。
もともとこれは、複数の人で使うことを想定したものではないので、もし 各担当者が同じファイルを見るというのが運用であるなら、そもそもシート単位 でファイルを分けるようにした方が良いようにも見えます。
一度分けたものはそちらを正として、元データは単なる記録とした方が、 素直な気がしますが、最終的にはどのような結果を残したいのでしょうか。
今一度、運用の流れを詳細に説明した方が良いように思います。 (Mook)
とんでもございません。
親身に考えていただいて有難い限りです！！
運用の流れとしては営業推進状況また新規顧客獲得報告の際に使用したいです。
・毎日情報会社から流れてくる「入力」シートのA〜H項目のデータを私が入力 ※この際既存顧客で担当が決まっている会社は私がB列に担当名を記入、新規顧客・担当不明は"担当無"と記入
↓
・各担当別に振分けられた顧客の営業推進状況を担当が"Hの結果""Iの備考"に記入。又、新規顧客獲得に向け「担当無」シートからやりたい案件を探す。
↓
やりたい案件が他営業と被らないよう選択した"担当無"案件は選択した担当のシートに反映後削除するか選択した担当の名前を記入したい。
↓
各担当が同時に作業を出来るようにしたいのでブック別で振分けした方が効率等いいのかな？とも思いましたが、上司が各担当の推進状況を随時チェックするため何個もブックを開くより１つのブックでシートをクリックするだけでチェックできるようにした方がいいかなと思い、別シートに振分けにしました。
まずファイルを分けるかどうかですかが、こればかりはアイルさんが最終的には 判断する必要があると思います。
実務者が多少不便でも、
上司が各担当の推進状況を随時チェックする
が最優先なのか、上司が確認する頻度は週に１度程度だから、日々の記入者の利便 性が優先なのか。といった事情から考えることになると思いますが。
記入する人数と、一人あたりの記入時間にもよりますが、運用上１ファイルで問題 なさそうでしょうか。
具体的な内容は、また後ほど書きますね。 (Mook)
Mook様のいうように上司の確認は週１程度なので担当ごとのブックに振り分けにしたいと思います。
共有ブックは壊れやすいとも聞きましたので･･･
ご教授いただいても宜しいでしょうか･･･？
(アイル)
#あら、ぶつかっちゃいましたね。 #ちょっとそのままアップします。
いろいろなアイデアが出るところですが、やはりアイルさん自身で内容を把握できて管理 ができるとなると、最初は一つのファイルでの管理かなという気がしてきています。 便利なことをしようとすると、たいていはそれだけ仕組みも複雑になります。
一つのファイルで行う場合、下記によりやり方が変わってきますが、どうでしょうか。 最初はなるべく簡単に実装できるよう工夫した方が、良いように思います。
1) No は運用中連番で採番したほうが良いと思いますが、それは問題ないですか。 2)元データのシートと振り分け後のシートの列構成を統一したほうが、管理しやすいと 思うのですが、一緒にできない理由はありますか。 ※シートにシート名と同じ名前があるのは冗長ですが、列を隠す対応では問題ありますか。 3）各担当者で入力した内容はマスターシートに反映する必要は無いと考えていいですか。
今回の方法とは関係しないアイデアレベルだけですが、下記のような方法もあると 思います。 余裕があれば、調べてみるのもいいかもしれません。
・案１ マスタ登録ファイル⇒担当者ファイルへ追記・更新 担当者ごとにファイル作成 ⇒ 保存時に進捗管理ファイルへ内容を更新 管理者は進捗管理ファイルを参照
・案２ データは mdb ファイルへ登録 担当者も実施者も都度データをマスタファイルから読み込み、終了時に更新 (Mook)
追記： 提案と方針が反対方向になってしまいましたが、一度上記を確認してもらえますか。 ファイルが壊れるという懸念に関しては、ぜひバックアップをとる運用を検討してください。 簡易的には保存時にバックアップを取るというような仕組みも取れます。 シートの枚数（ファイルを更新する人）の数はどのくらいなのでしょうか？
1) No は運用中連番で採番したほうが良いと思いますが、それは問題ないですか。 →問題ないです！ 2)元データのシートと振り分け後のシートの列構成を統一したほうが、管理しやすいと 思うのですが、一緒にできない理由はありますか。 ※シートにシート名と同じ名前があるのは冗長ですが、列を隠す対応では問題ありますか。 →すみません；ここは特に深くは考えてませんでした･･･こちらもまったく問題ないです！！ 3）各担当者で入力した内容はマスターシートに反映する必要は無いと考えていいですか。 →各担当のシートデータを印刷し会議の際全員に配布するのでマスターシートへの反映は必要ないです。
シートの枚数は元データとなる「入力」シート・「担当無」シート・各担当シート15人分の計17枚です。
今後増えることもないと思います。
ファイルはバックアップを取ることにします！
勉強中とはいえほぼ無知に等しいのでMook様におんぶにだっこで申し訳ありません･･･
案１・２はとても気になるので調べてみます！！
(アイル)
一度分類した後に追加分を更新したいという要望はよくありそうな気がするので、一般機能 としてマクロを改版しました。 （Mook)
'//-------------------------------------------------------- '// Grouping V2.1 '//-------------------------------------------------------- '// 処理：データを種類ごとにシートに分類 '//-------------------------------------------------------- '// 処理するファイル内にマクロを置いて実行してください。 '//-------------------------------------------------------- '// V1.0 初版作成 '// V2.0 makeNewFile オプションの追加、appendMode の追加 '// V2.1 appendMode に差分データの追記モードを追加 '//-------------------------------------------------------- Option Explicit
'//-------------------------------------------------------- '// ファイルに併せて設定 '//-------------------------------------------------------- Public masterSheetName '--- 元データシート名 : // V2.1 定数から変数へ変更
'//-------------------------------------------------------- '// 処理の行・列定義 '//-------------------------------------------------------- Const checkCol = "B" '--- 元データの分割判定を行う列 Const checkLastCol = "A" '--- 各シートの最終列を判定する列 Const rowUnitSize = 1 '--- コピー行単位 Const dataStartLine = 5 '--- 各シートのデータ開始行（ヘッダ行＋１） Const IDCol = "A" '--- appendMode が 2 のときのみ使用：この列は重複データが無いように運用のこと
'//-------------------------------------------------------- '// オプション '//--------------------------------------------------------
'//------------------------- '// 1)処理先ファイルの指定 // V2.0 で追加 '// True ・・・ 新規ファイルで作成 '// False ・・・ 自ブック内に作成 Const makeNewFile = False
'//------------------------- '// 2)追記モードの指定 // V2.0で追加 '// V2.1 オプション体系の変更 '// 上記の 1) オプションが False のときのみ有効 '// 0 ・・・ データ再登録 ★注意：Master シート以外をすべて再作成します '// 1 ・・・ データを追記 ★注意：2回実行すると同じものが追加されます '// 2 ・・・ 差分データを追記 ★注意：指定列が重複しないように追加します：IDCol で指定 Const appendMode = 2
'//-------------------------------------------------------- Const tmpSheetName = "TMP" '--- 作業用テンプレートシート名
'//--------------------------------------------------------
Sub Grouping()
'//--------------------------------------------------------
GroupingMain "ALL" '// 分割をしたいシート名を指定
End Sub
'//--------------------------------------------------------
Sub GroupingMain(argMasterWorksheetName)
'//--------------------------------------------------------
Dim i As Long, lastRow As Long
Dim dstWB As Workbook
Dim ws As Worksheet
masterSheetName = argMasterWorksheetName
'//--- 開始処理
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets(masterSheetName)
lastRow = .Range(checkCol & Rows.Count).End(xlUp).Row
If makeNewFile = True Then
.Copy
Set dstWB = ActiveWorkbook
dstWB.Worksheets(masterSheetName).Name = tmpSheetName
dstWB.Worksheets(tmpSheetName).Rows(dataStartLine & ":" & Rows.Count).Clear
Else
If appendMode = 0 Then
If MsgBox(masterSheetName & "以外を再作成します。よろしいですか？", vbYesNo) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> masterSheetName Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End If
Set dstWB = ThisWorkbook
.Copy after:=ThisWorkbook.Worksheets(1)
dstWB.Worksheets(2).Name = tmpSheetName
dstWB.Worksheets(tmpSheetName).Rows(dataStartLine & ":" & Rows.Count).Clear
End If
For i = dataStartLine To lastRow
If .Cells(i, checkCol).Value <> "" Then
AddLine dstWB, i, .Cells(i, checkCol).Value
End If
Next
End With
'//--- 終了処理
Application.DisplayAlerts = False
dstWB.Worksheets(tmpSheetName).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'//--- 表示位置の調整
sortSheet dstWB
For Each ws In dstWB.Worksheets
Application.Goto Reference:=ws.Range("A1"), Scroll:=True
Next
dstWB.Worksheets(1).Activate
End Sub
'//--------------------------------------------------------
Private Sub AddLine(dstWB As Workbook, lineNum&, sheetName$)
'//--------------------------------------------------------
' コピー先シートにデータをコピー
'---------------------------------
Dim lastLine As Long
Dim sWord As String
Dim fRange As Range
checkAndMake dstWB, sheetName
lastLine = dstWB.Worksheets(sheetName).Range(checkLastCol & Rows.Count).End(xlUp).Row + 1
If appendMode = 2 Then
sWord = ThisWorkbook.Worksheets(masterSheetName).Cells(lineNum, IDCol).Value
If sWord <> "" Then
With dstWB.Worksheets(sheetName)
Set fRange = .Range(.Cells(dataStartLine, IDCol), .Cells(lastLine, IDCol)).Find(sWord, lookat:=xlWhole)
End With
If Not fRange Is Nothing Then Exit Sub
End If
End If
ThisWorkbook.Worksheets(masterSheetName).Rows(lineNum & ":" & lineNum + rowUnitSize - 1).Copy
dstWB.Worksheets(sheetName).Rows(lastLine).Insert Shift:=xlDown
End Sub
'//--------------------------------------------------------
Private Sub checkAndMake(dstWB As Workbook, sheetName$)
'//--------------------------------------------------------
' コピー先シートがあるかチェックしなければ作成
'---------------------------------
Dim tmpWS As Worksheet
On Error Resume Next
Set tmpWS = dstWB.Worksheets(sheetName)
If tmpWS Is Nothing Then
dstWB.Worksheets(tmpSheetName).Copy after:=dstWB.Worksheets(dstWB.Worksheets.Count)
dstWB.Worksheets(dstWB.Worksheets.Count).Name = sheetName
End If
On Error GoTo 0
End Sub
'//--------------------------------------------------------
' シートを名前順でソート
'---------------------------------
Private Sub sortSheet(dstWB As Workbook)
Dim i As Long, j As Long, startI As Long
If makeNewFile = True Then
startI = 1
Else
startI = 2
End If
For i = startI To dstWB.Worksheets.Count - 1
For j = i + 1 To dstWB.Worksheets.Count
If StrComp(dstWB.Worksheets(i).Name, dstWB.Worksheets(j).Name) > 0 Then
dstWB.Worksheets(j).Move before:=dstWB.Worksheets(i)
End If
Next
Next
End Sub
さて今回の目的のためには、上記を基本として、下記のように運用してはどうでしょうか。
ID 列（A列？）にはファイル全体での管理番号をつけるように運用してください。 この番号があるかどうかで、コピーするかしないかを判断しています。 (Mook)
標準モジュール Module1 に上記のコードをコピーし、下記の2行を変更してください。
・変更１
Sub Grouping()
↓
Private Sub Grouping()
・変更２
'//--- 表示位置の調整
sortSheet dstWB
↓
'//--- 表示位置の調整
' sortSheet dstWB
標準モジュール Module2 に
Sub 入力分類()
GroupingMain "入力"
'// 担当者シートのB列（担当者名）を非表示に
Dim ws As Worksheet
For Each ws In Worksheets
If InStr("入力/担当無", ws.Name) = 0 Then
ws.Columns("B").ColumnWidth= 0
End If
Next
End Sub
Sub 再分類()
GroupingMain "担当無"
End Sub
ありがとうございます！！
しかしモジュール1を実行すると以下のように各担当の１番下のNOに反映されてしまいます･･･
「鈴木」シート
A B C D E … H I 4会社名 住所 商品名… 結果 備考 ･ ･ 79 A社 千葉 ペン赤… 80 C社 埼玉 消しゴム…
そしてモジュール2を実行すると コンパイルエラーとなって Sub 再分類()←この箇所が黄色くなってしまいます。
モジュールの変更箇所を間違えているのでしょうか？？
説明が不足していましたが、Module1 は直接実行しないでください。 （Grouping が見えなくなるように Private をつけたのですが、実行できますか？） 「入力分類」 は『入力』シートからの初回実行用、「再分類」 は『担当無』シート からの更新用です。
出ているエラー状況（特にエラーメッセージ）をもう少し細かく説明してらえますか。 最初の説明と、上記の説明は列構成がずれていると思いますが、Module1 の Const の 部分は実際のシート構成に合わせてください。 当初の説明にあわせたつもりですが、実際と異なるのであれば調整が必要です。
項目を識別するための ID は必須ですのでない場合は、連番を全体に振ってください。 入力をいったん削除してから新しい項目を追加する場合も、前回の最後の番号から 続けるよう採番して下さい。
いきなりは難しいかもしれませんが、マクロを業務運用するなら内容を理解するよう にがんばって下さいね。 わけのわからないまま使い続けるのは、危ないので老婆心ながら。 （Mook）
Mook様ただでさえ図々しく色々考えて頂いているのに優しいお言葉まで･･･しかと胸に刻み勉強に励みます！！
そして申し訳ありません上記の件は私がややこしくしてしまいました･･･。
先ほどModule1を実行してしまったところ各担当の列構成が上記のようになって反映されたのでそのまま記入しました。
使用する列構成は最初の説明の通りです。
今ブックを閉じ全て最初からやり直しModule1は実行せずModule2を実行したところエラー等は何もでないのですがデータが反映されません（涙）
おそらくIDのつけ方が間違っているのかな？と思うのですが、IDは「入力」シートのA4から 1 と入力して2 3 4 5…81(とりあえず81まで付けました)となるように下までコピーし、次のシートが「担当無」シートなのでまた担当無シートのA4から82 83 84 85･･･と採番し次のシートも同様｢担当無」シートから番号が続くようにしたのですがこれが間違いでしょうか？
｢入力｣シート 「担当無｣シート
A A 4 1 4 82 5 2 5 83 6 3 6 84 ･ ･ ･ ･ 83 81 83 161
以上のようにしました。
もの凄く初歩的な事で申し訳ありません･･･
(アイル)
やはり内容を理解しないといけないですね＾＾。
入力シートにA4:A104 まで １〜100まで番号がついているとしたら、これを消してまた 入力シートに新しいデータをつけるときに 101 〜つけてください、ということで、 振り分けた各シートのIDはいじってはいけません。
それを変えてしまったら、再度振り分けるときに、どれが元のデータか識別できないです よね。 担当無 の 10 番が 鈴木 になったときに、「鈴木」シートに 10 が有るか無いかを見て コピー判断をしています。
そのあたりの仕組みは理解しないと、運用のときに管理できないので、がんばってください。
それから、行と列は大丈夫ですよね？ 最初の説明ではA列は No になっていますが、後者では会社名になっています。 マクロでは IDCol = "A" となっているので、ここが Noで無いと期待通りに動かない と思います。 （Mook）
本日無事実行できました！！
私のやりたい事が見事に反映されていて大感激です（涙）
マクロ作成して頂けるだけではなく優しく丁寧に色々教えて頂きありがとうございました。
もっと勉強してMook様の案１を自分で作成できるよう頑張ります！！
本当に色々ありがとうございました。
紹介しようと見たら消えていたので、復旧 (Mook)
古いバグを修正。 ・Integer 型を Long 型に変更 （Mook） 2015/01/16(金) 16:51
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.