日付 支店 金額 商品 7/1 東京 5000 A 7/1 大阪 2000 B 7/1 博多 500 A 7/1 横浜 1000 C sheet1に
日付 支店 金額 商品 7/1 東京 5000 A 7/1 大阪 2000 B 7/1 博多 500 A 7/1 横浜 1000 C sheet1に 日付から商品：A1～D1 以降は、A2～D2 までが１つのデータ これが二行目以降からあります。 これを商品をキーに金額を合算して、 支店を１つのセルにまとめたいのですが、どのようなマクロを作りたいのですがどのようにしたら良いか分からず悩んでいます。 やりたいイメージ 日付 支店 金額 商品 7/1 東京、博多 5500 A 7/1 大阪 2000 B 7/1 横浜 1000 C ※今回のイメージでは２つですが、 重複がそれ以上あれば３つ以上になることもあります。 可能であれば、同じシート内でできれば ありがたいですが難しかったら、別シートになって大丈夫です。 どなたかご教示よろしくお願いいたします。
Excel | Visual Basic・66閲覧・500
ベストアンサー
商品をキーに金額を合算といっても、日付が違えば別の行でいいのですよね？ 同じシートで書き換えますのでバックアップを取ってからテストして下さい。 Sub test() Dim dic As Object Dim rmax As Long, r As Long Dim dkey As Variant Dim vals As Variant Dim buf As Variant Dim i As Integer Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") rmax = Cells(Rows.Count, 1).End(xlUp).Row For r = 2 To rmax 'キー作成 dkey = Cells(r, 1).Value & "*" & Cells(r, 4).Value If dic.Exists(dkey) = False Then vals = Array(Cells(r, 2).Value, Cells(r, 3).Value) dic.Add dkey, vals Else vals = dic.Item(dkey) vals(0) = vals(0) & "、" & Cells(r, 2).Value vals(1) = vals(1) + Cells(r, 3).Value dic.Item(dkey) = vals End If Next r '元データクリア Range("A2:D" & rmax).ClearContents r = 1 'キーごとの処理 For Each dkey In dic.Keys r = r + 1 Cells(r, 1).Value = Split(dkey, "*")(0) vals = dic.Item(dkey) Cells(r, 2).Value = vals(0) Cells(r, 3).Value = vals(1) Cells(r, 4).Value = Split(dkey, "*")(1) Next dkey Set dic = Nothing Application.ScreenUpdating = True End Sub
質問者からのお礼コメント
ご認識のとおり、日付がちがったら 別で間違いございません。 少し説明足らずで申し訳ございません。 お二人のマクロでテストし、 無事に稼働いたしました。 優劣つけがたいですが、先にお答え頂いた回答者様にベストをつけさせて頂きます。もう１方の回答者様も本当にありがとうございました。 私自身マクロは未熟なので、また困ったらご教示頂けますと幸いです。朝早くに回答ありがとうございました。御礼申し上げます。
お礼日時：7/4 10:24
