重複データーの集計、削除

質問

どなたかご教授下さい。
下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。
さらに、重複する基準となる列を複数(D列,F列,Ｇ列)に増やしたいのですが、上手く出来ません。
宜しくお願い致します。

Sub test()
Dim i, j
For i = 19 To Cells(Rows.Count, 2).End(xlUp).row - 1
For j = Cells(Rows.Count, 2).End(xlUp).row To i + 1 Step -1

If Cells(i, 4).value = "" Then Exit Sub
If Cells(i, 4).value = Cells(j, 4).value Then
Cells(i, 9).value = Cells(i, 9).value + Cells(j, 9).value
Rows(j).Delete
End If
Next
Next

End Sub

回答No.5

bin-chan

If Cells(i, 4).value = Cells(j, 4).value Then

を

If Cells(i, 4).value = Cells(j, 4).value _　''valueの後ろに半角スペースと半角アンダースコア
And Cells(i, 5).value = Cells(j, 5).value _　''valueの後ろに半角スペースと半角アンスコア
And Cells(i, 6).value = Cells(j, 6).value Then

に変更

回答No.4

tom04

こんばんは！
安直な方法になってしまいますが・・・
作業用の列を2列使っています。

Sub test()
Dim i As Long
Columns("D:E").Insert
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row
Cells(i, 4) = Cells(i, 6) & Cells(i, 8) & Cells(i, 9)
Next i
For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row
If WorksheetFunction.CountIf(Range(Cells(1, 4), Cells(i, 4)), Cells(i, 4)) = 1 Then
Cells(i, 5) = WorksheetFunction.SumIf(Columns(4), Cells(i, 4), Columns(11))
End If
Next i
For i = Cells(Rows.Count, 4).End(xlUp).Row To 1 Step -1
If Cells(i, 5) = "" Then
Rows(i).Delete
Else
If Cells(i, 5) <> Cells(i, 11) Then
Cells(i, 11) = Cells(i, 5)
End If
End If
Next i
Application.ScreenUpdating = True
Columns("D:E").Delete
End Sub

※　For～Next　で3度LOOPしていますので、他に良い方法があればごめんなさいね。m(_ _)m

回答No.3

mu2011

>上手く出来ません。
　⇒何が「上手くいかない」のかが不明です。
　　補足説明した方が良いのではないでしょうか。

補足

上手く出来ません
↓
重複する基準となる列を複数にする場合のマクロのコードが上手く出来ません。
If Cells(i, 4).value = Cells(j, 4).value Then
このように、一つの列だけを基準とする場合は上記のようなコードで良いのですが、
複数列を基準にしようとした場合コードをどのように組めば良いかわかりません。

例

… D　・ F　　 G 　・ I
1 東京 バラ 　5輪 　　5
2　大阪　 バラ 5輪 　　5
3　福岡　 ユリ　　3輪 　　 5
4　大阪　 ユリ　　3輪 　　4
5　東京　 バラ　 5輪 　　5

↓
… D　・ F　　 G 　・ I
1 東京 バラ 　5輪 　 10 　　
2　大阪　 バラ 5輪 　　5
3　福岡　 ユリ　　3輪 　　 5
4　大阪　 ユリ　　3輪 　　4
5

(A,B,C,E,H列は省略しています)

<説明>
D,F,G列3列の値が同じになる行がある場合I列で足し算され、加算された行の値は削除
異なる場合は、そのまま残る。というようにマクロで出来ればと思っています。
今の状態だと、D列が同じ行はF,G列が異なっても全て加算され削除されてしまいます。

宜しくお願いします。

回答No.2

imogasi

2重ループの部分は下記を参考に考えては。
Sub test01()
MsgBox "全行数=" & Rows.Count
For Each cl In Range("d1, f1, h1")
MsgBox "現在の処理列" & cl.Column
d = Cells(Rows.Count, cl.Column).End(xlUp).Row
MsgBox "データ最終行=" & d
For i = 1 To d
MsgBox Cells(i, cl.Column) '本番はここで処理のコードを書く
Next i
Next
End Sub
常識的に考えて、１０列程度以内なら、Range("d1, f1, h1")　のところに書き込んで
飛び飛び列を処理する場合は上記がすっきり書けるコードの１つだろう。

回答No.1

bin-chan

Forループの終了値
> Cells(Rows.Count, 2).End(xlUp).row - 1
は、いくつを期待してますか？

行削除するときは、最下行から先頭行に向けてループさせないと、
「今ドコにいるのかわからない」ことになります。