最大1万円超分の電子書籍プレゼント♪

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で可能でしょうか?

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

gooドクター

A 回答 (2件)

No.1です。



> sum As Integer,

これはいらなかったですね。
⇒使うの忘れてました。
    • good
    • 0
この回答へのお礼

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

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

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



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

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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング