(VBA)重複の削除後、合計を出したい

質問

ご覧頂きありがとうございます。

画像の通りデータを統合するマクロのコードを作成したいです。

・「会社名」が同じかつ「振出日」と「満期日」が同じなら、
「金額」を合計し重複する行を削除

するよう動作させるにはどのように書けばよいでしょうか。
ご教示いただけますと幸いです。

回答No.2

kkkkkm · ベストアンサー

行を実際に削除するのでしたら

Sub Test()
Dim i As Long, j As Long, LastRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = LastRow To 2 Step -1
For j = i - 1 To 2 Step -1
If Cells(i, "A").Value = Cells(j, "A").Value And _
Cells(i, "C").Value = Cells(j, "C").Value And _
Cells(i, "D").Value = Cells(j, "D").Value Then
Cells(i, "B").Value = Cells(i, "B").Value + Cells(j, "B").Value
Rows(j).Delete
End If
Next
Next
End Sub

お礼

kkkkkm　さま

いつも教えて下さって、本当にありがとうございます...!

今回は自分が書いたコードに質問の処理を追加したかったので、
行を削除するこちらのコードを使わせて頂きたいと思います。

当初、値をつなげたキーを元に検索→集計...と考えておりましたが、
こんな綺麗なコードで済むなんて感動です。指定箇所の変更もしやすいですし。
ありがとうございました！

回答No.3

kkkkkm

転記したい場合、たとえばF列以降に転記する場合、AからD列をFからI列に全てコピーして行削除とほぼ同じコードで行削除ではなくセルの削除で。

Sub Test2()
Dim i As Long, j As Long, LastRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(1, "F").Resize(LastRow, 4).Value = Range(Cells(1, "A"), Cells(LastRow, "D")).Value

LastRow = Cells(Rows.Count, "F").End(xlUp).Row

For i = LastRow To 2 Step -1
For j = i - 1 To 2 Step -1
If Cells(i, "F").Value = Cells(j, "F").Value And _
Cells(i, "H").Value = Cells(j, "H").Value And _
Cells(i, "I").Value = Cells(j, "I").Value Then
Cells(i, "G").Value = Cells(i, "G").Value + Cells(j, "G").Value
Cells(j, "F").Resize(1, 4).Delete Shift:=xlShiftUp
End If
Next
Next
End Sub

回答No.1

bardfish

SQLだとこれで済むんですけどね・・・

SELECT 会社名, 振出日, 満期日, Sum(金額) AS 金額
FROM テーブル1
GROUP BY 会社名, 振出日, 満期日

ExcelでもSQLを使う方法があるかもしれませんので探してみてください。
SQLServer Expressというものが無料で使えるのでデータベース作成してテーブルを作って集計を出すVIEWを作ってその結果をExcelに取り込めばマクロ/コードを作る手間はなくなります。
そのかわりSQLを勉強しないといけないですけどね…

ご希望の回答ではありませんが、こういう方法もありますということで今後の検討材料として頭の片隅に捨てておいてください(^^;

お礼

bardfish　さま
ありがとうございます。
SQLを使うとそんなに簡単に出来るんですか...!　（驚
VBAが上達したのち、accessの予定でしたがSQLも併せて学習してみたいと思います^^

ありがとうございました！