エクセル2003のマクロ作成の件

質問

同一連続セルにあるグループの中で、D列に「完了」があれば、F列に「4」を入力し、その同一連続セル内で、検索し、D列の対応中を探します。その「対応中」の先頭が、完了にした担当者と同じであれば、「9」を。違えば、「0」を。完了は、同一セル内の最後にきていない事もあります。該当しない時や単一セルの時は、何もせず、空白のままにします。A列には、空白行がなく、3万行ほどあります。特定文字を探し、その1行上を探すなどののマクロはできるのですが、条件が重なると、作成が出来ません。今まで、手動で、数値を入れていたのですが、マクロで作成出来ないものでしょうか？マクロ初心者です。

回答No.3

tom04 · ベストアンサー

こんばんは！
画像の黄色い部分が一つのグループだと思いますが、
「691」と「991」が混在していますね？
これは同じ番号だとします。

一例です。
元データはSheet1にあるとします。
標準モジュールにコピー＆ペーストしてマクロを試してみてください。

Sub test() 'この行から
Dim i As Long, j As Long, k As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
i = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Range(ws1.Cells(2, 6), ws1.Cells(i, 6)).ClearContents
Range(ws1.Columns(1), ws1.Columns(3)).Insert
Range(ws1.Cells(2, 1), ws1.Cells(i, 1)).Formula = "=row()"
Range(ws1.Cells(2, 2), ws1.Cells(i, 2)).Formula = "=IF(COUNTIF($D$2:D2,D2)=1,ROW(),"""")"
ws1.Cells(2, 3) = ws1.Cells(2, 2)
Range(ws1.Cells(3, 3), ws1.Cells(i, 3)).Formula = "=IF(B3="""",C2,B3)"
ws1.Columns(2).Copy
ws3.Activate
ws3.Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlValues
i = ws3.Cells(Rows.Count, 1).End(xlUp).Row
Range(ws3.Cells(1, 2), ws3.Cells(i, 2)).Formula = "=IF(A1="""",2,1)"
Range(ws3.Columns(1), ws3.Columns(2)).Sort key1:=ws3.Cells(2, 1), order1:=xlAscending
For j = 2 To ws3.Cells(Rows.Count, 2).End(xlUp).Row
Range(ws1.Columns(1), ws1.Columns(9)).AutoFilter field:=3, Criteria1:=ws3.Cells(j, 1)
Range(ws1.Columns(1), ws1.Columns(9)).Copy
ws2.Activate
ws2.Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlValues
If ws2.Cells(Rows.Count, 1).End(xlUp).Row > 2 Then
If WorksheetFunction.CountIf(ws2.Columns(7), "完了") Then
k = WorksheetFunction.Match("完了", ws2.Columns(7), False)
ws1.Cells(ws2.Cells(k, 1), 9) = 4
If ws2.Cells(2, 7) = "対応中" Then
If ws2.Cells(2, 6) = ws2.Cells(k, 6) Then
ws1.Cells(ws2.Cells(2, 1), 9) = 9
Else
ws1.Cells(ws2.Cells(2, 1), 9) = 0
End If
End If
End If
End If
Next j
ws2.Cells.ClearContents
ws3.Cells.ClearContents
ws1.Activate
ws1.Cells(1, 1).Select
Selection.AutoFilter
Range(ws1.Columns(1), ws1.Columns(3)).Delete
Application.ScreenUpdating = True
End Sub 'この行まで

※　Sheet2・Sheet3を作業用のSheetとして使用していますので、Sheet2・Sheet3は使っていない！という前提です。

※　データ量が3万程度あるというコトなので結構時間を要すると思います。

参考になりますかね？m(_ _)m

回答No.2

KURUMITO

複雑なものはマクロでということでしょうか？マクロが必ずしもすぐれた方法ではありません。マクロでしかできないものはマクロで対応する、関数で対応できるものであればその方が計算速度からみてもよいでしょう。
お示しの表では691と991が同じグループになっていますがどちらかの数値が間違っているのですね。
F2セルには次の式を入力して下方にドラッグコピーすることで良いでしょう。

=IF(A2="","",IF(COUNTIF(INDEX(D:D,MATCH(A2,A:A,0)):INDEX(D:D,MATCH(A2,A:A,0)+COUNTIF(A:A,A2)-1),"完了")=0,"",IF(AND(D2="完了",COUNTIF(A:A,A2)>1),4,IF(AND(D2="対応中",COUNTIF(INDEX(D:D,MATCH(A2,A:A,0)):INDEX(D:D,ROW(A2)),"対応中")=1,C2=INDEX(INDEX(C:C,MATCH(A2,A:A,0)):INDEX(C:C,MATCH(A2,A:A,0)+COUNTIF(A:A,A2)-1),MATCH("完了",INDEX(D:D,MATCH(A2,A:A,0)):INDEX(D:D,MATCH(A2,A:A,0)+COUNTIF(A:A,A2)-1),0))),9,IF(AND(D2="対応中",COUNTIF(INDEX(D:D,MATCH(A2,A:A,0)):INDEX(D:D,ROW(A2)),"対応中")=1,C2<>INDEX(INDEX(C:C,MATCH(A2,A:A,0)):INDEX(C:C,MATCH(A2,A:A,0)+COUNTIF(A:A,A2)-1),MATCH("完了",INDEX(D:D,MATCH(A2,A:A,0)):INDEX(D:D,MATCH(A2,A:A,0)+COUNTIF(A:A,A2)-1),0))),0,"")))))

回答No.1

rokkkkkk123

こんな感じでどうでしょう。
０元の表はバックアップをとっておくこと
１．グループの基準となるIDを振った列を1行追加する
２同一グループの中でA.対応中、B.完了など決まった順で並びかえの出来るように呼称を置換する
３．１グループID、２ステータスの順に事前に並び替える
（判断基準が完了なので同一グループの中で完了が一番先頭に来るようにすること）
４．1行目からループ処理を行う。ループカウンタの1行目でD列が完了であれば担当者をワークに保存する
そうでなければ何もしない
５．次の行を読む。その行のD列が対応中であればその行の先に保存したワークの内容とその行の担当者を比較
。完了にした担当者と同じであれば、「9」を。違えば、「0」を対象行のセルに設定する。
６．グループDが変わったらカウンタとワークをクリアして同様の処理をグループ分最後まで繰り返す。

かなり大雑把な説明になってしまいましたが、マクロで作成出来ないものでしょうか？というのがどういうものをイメージされているかわかりませんが、答えとしてはできます。ただし自動記録マクロだけではちょっと無理があり、プログラムチックなものになります。もっと良い方法があれば他の皆様に委ねます。