VBAについて質問です

質問

添付されている画像のように表があり、部署別に品名が一致した場合、品名毎の数量を加算集計して『部署名』『品名』『型番』『集計結果の数量』をSheet2へ表示させたい場合、どのような記述を行えばよろしいでしょうか？
ご回答宜しくお願いします。

回答No.2

30246kiku · ベストアンサー

ブログにも記述していますが、以下、使えそうなところを・・・・
標準モジュールに以下を記述しておきます。

Public Sub GrpSums(rng1 As Range, rng2 As Range, rng3 As Range)
　　Dim dic As Object
　　Dim r As Range
　　Dim sS As String
　　Dim v As Variant
　　Dim iLoop As Long
　　Dim i As Long, j As Long
　　Const sDLM As String = "__"

　　iLoop = rng1.CurrentRegion.Rows.Count - 1
　　If (iLoop < 1) Then Exit Sub
　　If (rng3.Count <> 1) Then Exit Sub

　　Set dic = CreateObject("Scripting.Dictionary")
　　For i = 1 To iLoop
　　　　sS = ""
　　　　For Each r In rng1.Offset(i)
　　　　　　sS = sS & sDLM & r
　　　　Next
　　　　v = dic.Item(sS)
　　　　If (Not IsArray(v)) Then ReDim v(rng2.Count + 1)
　　　　j = 0
　　　　For Each r In rng2.Offset(i)
　　　　　　v(j) = v(j) + r
　　　　　　j = j + 1
　　　　Next
　　　　v(j) = v(j) + 1 ' 出現個数（後々使えるかも）
　　　　v(j + 1) = i　　' 見出しからの相対行（結果を表示する際のコピー元）
　　　　dic.Item(sS) = v
　　Next

　　With rng3
　　　　rng1.Copy .Offset(0, 0)
　　　　i = rng1.Count
　　　　For Each r In rng2
　　　　　　.Offset(, i) = r & "計"
　　　　　　i = i + 1
　　　　Next
　　　　i = 1
　　　　For Each v In dic.items
　　　　　　j = v(rng2.Count + 1)
　　　　　　rng1.Offset(j).Copy .Offset(i)
　　　　　　.Offset(i, rng1.Count).Resize(, rng2.Count) = v
　　　　　　i = i + 1
　　　　Next
　　End With
　　Set dic = Nothing
End Sub

使い方）

Call GrpSums(rng1 As Range, rng2 As Range, rng3 As Range)

rng1：グループとしてみなす項目を指定
rng2：合計する項目を指定
rng3：結果を表示するところを指定

指定例）

Call GrpSums(Range("B3:F3"), Range("H3:I3"), Range("B20"))　　とか
Call GrpSums(Range("B3,C3,E3,F3,H3"), Range("J3,L3"), Range("B20"))　　とかとか

添付図であれば以下の様な雰囲気かも

> 部署別に品名が一致
ということですが、「型番」もグループ条件に含めます

Sheet2 をクリアしてから
With Worksheets("Sheet1")
　　Call GrpSums(.Range("A1:C1"), .Range("D1"), Worksheets("Sheet2").Range("A1"))
End With

もし、「型番」をグループ条件から外す場合は、"A1:C1" を "A1:B1" とか "A1,B1" に・・・
その時には、結果の表示からも「型番」は消えます。

まず、rng1、rng2 で指定する項目の行は、同じでなくてはなりません。
rng1 で指定された CurrentRegion の範囲で Offset を用いてグループ、合計を処理していきます。
グループを管理する方法として、
・全項目を１つの文字列にして、同じ文字列になったものをグループとして扱いましょう。
・この同じ・・・ Dictionary のキーとしてまとめていきましょう。
・合計値は、Dictionary のItem として、配列で加算していきましょう。
　そして、Item の配列内に、グループとして何個扱ったか、
　また、元々の値は何行目を参照したか覚えておいて、結果出力時にコピー元にしちゃいましょう。

なお、グループ化するセルの内容はそのままになります。
（数値であっても文字であってもかまいません）

データが正しければ、そこそこ動くと思います。
不都合あれば、修正してください。

回答No.1

mu2011

こんな感じです。
データシートのシートタブ上で右クリック→コードの表示→サンプルコード貼り付け→シート上でAlt＋F8キー押下、sample実行

Sub sample()
Dim i As Long, db, wk
Set db = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
wk = Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3)
db(wk) = db(wk) + Cells(i, 4)
Next
wk = db.keys
With Sheets("sheet2")
.Cells.Clear
.Cells(1, 1).Resize(, 4) = Cells(1, 1).Resize(, 4).Value
For i = 0 To UBound(wk)
.Cells(i + 2, 1).Resize(, 3) = Split(wk(i), ",")
.Cells(i + 2, 4) = db(wk(i))
Next
End With
Set db = Nothing
End Sub