ここから本文です

エクセルVBAで、ある複数の項目をキーにして、合計を出したい。 たとえば、、、...

oshi_ete_neさん

2013/11/1513:47:50

エクセルVBAで、ある複数の項目をキーにして、合計を出したい。

たとえば、、、
山田 シャツ 赤 1 5000
山田 シャツ 赤 1 5000
山田 シャツ 白 1 5000
鈴木 シャツ 赤 1 5000
田中 シャ

ツ 赤 1 5000
田中 パンツ 白 1 2000
山田 シャツ 白 1 5000
山田 シャツ 白 1 5000
山田 パンツ 赤 1 2000



山田 シャツ 赤 2 10000
山田 シャツ 白 1 5000
鈴木 シャツ 赤 1 5000
田中 シャツ 赤 1 5000
田中 パンツ 白 1 2000
山田 シャツ 白 2 10000
山田 パンツ 赤 1 2000

という感じです。
ちなみに色のあとの数字は件数、金額です。
ちょっと複雑ですが、、

よろしくお願いいたします。

閲覧数:
993
回答数:
2

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

2013/11/1515:00:34

提示の表が、A1から始まっているとして、
A~C列をコピーして、「重複データの削除」を実行して重複を排除。
あとは、D、E列に「SUMIFS関数」を埋め込み、式を消せば、簡単なのでは?
マクロ記録の結果に少し手を加えれば、終わり。

以下のプログラムは、Sheet1のデータを元に、Sheet2に結果を出しています。

Const 式 As String = _
"=SUMIFS(Sheet1!D:D,Sheet1!$A:$A,$A1,Sheet1!$B:$B,$B1,Sheet1!$C:$C,$C1)"
Worksheets("Sheet1").Columns("A:C").Copy
With Worksheets("Sheet2")
.Columns("A:A").PasteSpecial xlPasteValues
.Columns("A:C").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
With .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
.Offset(, 3).Resize(, 2).Formula = 式
.Copy
.PasteSpecial xlPasteValues
End With
End With
Application.CutCopyMode = False


もし、Excel2007より前のバージョンなら
「重複データの削除」 ・・・ フィルターオプション
「SUMIFS関数」 ・・・・・・・ SUMPRODUCT関数
で、同様の結果を得られます。

質問した人からのコメント

2013/11/16 19:09:09

お二人ともありがとうございました。
自分にとって、翻訳しやすかった記述のほうにBAさせていただきます。

ベストアンサー以外の回答

1〜1件/1件中

mskz1954さん

2013/11/1521:10:24

一例です。
データをSheet1、Sheet2に集計しています。
Sheet1のシートタブ上で右クリック→コードの表示→サンプルコード貼り付け→シート上でAlt+F8キー押下、sample実行

Sub sample()
Dim i As Long, db, wk, wk1
Set db = CreateObject("Scripting.Dictionary")
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
wk = Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3)
If db.exists(wk) Then
wk1 = db(wk)
Else
wk1 = "0,0"
End If
wk1 = Split(wk1, ",")
wk1(0) = wk1(0) + Cells(i, 4)
wk1(1) = wk1(1) + Cells(i, 5)
db(wk) = Join(wk1, ",")
Next
wk = db.keys
With Sheets("sheet2")
.Cells.ClearContents
For i = 0 To UBound(wk)
.Cells(i + 1, "a").Resize(, 3) = Split(wk(i), ",")
wk1 = Split(db(wk(i)), ",")
.Cells(i + 1, "d") = wk1(0)
.Cells(i + 1, "e") = wk1(1)
Next
End With
Set db = Nothing
End Sub

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

5文字以上入力してください

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。