エクセルvbaで重複データを加算したい

ID 数量 名称 コード 要因
11768 20 レモン 黄色 AB
11770 50 レモン 黄色 AB
11780 10 パイン 黄色 AB
11784 20 りんご 赤 BC
11785 60 りんご 赤 XX
11787 20 りんご 赤 ZZ
11786 20 りんご 赤 YY
11788 20 りんご 赤 YY
11789 20 りんご 赤 YY
11791 30 りんご 赤 YY
11793 20 パプリカ 赤 YY


このようなデータがありまして、名称＋コード＋要因で単位で一致している物を重複データとして下記のように加算したいと思っています。


名称 コード 数量 要因
レモン 黄色 70 AB
パイン 黄色 10 AB
りんご 赤 20 BC
りんご 赤 60 XX
りんご 赤 20 ZZ
りんご 赤 90 YY
パプリカ 赤 20 YY

ネットを見て、エクセルVBAでマクロを書いていたのですが、が、加算すること出来ませんでした。
CreateObject("Scripting.Dictionary")を使用してしまうと重複データを割り出す事は出来ませんでした。


名称 コード 数量 要因
レモン 黄色 20 AB
パイン 黄色 10 AB
りんご 赤 20 BC
りんご 赤 60 XX
りんご 赤 20 ZZ
りんご 赤 20 YY
パプリカ 赤 20 YY

このように名称＋コード＋要因で最初に見付かったものだけを抽出してしまいました。
これのデータに対し、真ん中の表のように加算も行いたいのですが、エクセルvbaで可能でしょうか？

お力添えをお願いします。

No.2 ベストアンサー 回答者： めぐみん_ 回答日時： 2021/11/11 19:38

No.1です。

＞ sum As Integer,

これはいらなかったですね。
⇒使うの忘れてました。

この回答へのお礼

望み通りの処理でした！
ありがとうございました。

お礼日時：2021/11/12 09:07

No.1 回答者： めぐみん_ 回答日時： 2021/11/11 19:30

シート１のＡ１を起点とした表から集計してシート２のＡ１以降に書き出すものです。

違っていたらごめんなさい。

Sub megu()
Dim myDic As Object
Dim r As Range
Dim sum As Integer, st As String

Set myDic = CreateObject("Scripting.Dictionary")

With Worksheets("Sheet1")
For Each r In .Range("C2", .Cells(Rows.Count, "C").End(xlUp))

st = Join(WorksheetFunction.Index(r.Range("A1:C1").Value, 1, 0), "_")

If Not myDic.Exists(st) Then _
myDic.Add st, Array(r.Value, r.Range("B1").Value, _
WorksheetFunction.SumIfs(.Range("B:B"), .Range("C:C"), r.Value, .Range("D:D"), r.Range("B1").Value, .Range("E:E"), r.Range("C1").Value), _
r.Range("C1").Value)

Next
End With

With Worksheets("Sheet2")
.Cells.ClearContents
.Range("A1:D1").Value = Array("名称", "コード", "数量", "要因")
.Range("A2").Resize(myDic.Count, 4).Value = Application.Transpose(Application.Transpose(myDic.Items))
End With

Set myDic = Nothing

End Sub