ここでは Dictionary × Collection を組み合わせて、
「カテゴリ × 月 × 部署」など 多次元キーでのグループ集計 を高速化する VBA パターンを展開します。
Dictionary は「キー → 値」の 1 次元ですが、値に Collection や別 Dictionary を持たせることで多次元集計が可能になります。
基本構造（カテゴリ × 月 × 部署）
Sub MultiDimGroupSummary()
Dim dictCat As Object, dictMonth As Object, dictDept As Object
Dim r As Range, keyCat As String, keyMonth As String, keyDept As String
Dim val As Double
' 最上位 Dictionary（カテゴリ）
Set dictCat = CreateObject("Scripting.Dictionary")
' データ範囲を走査
For Each r In Range("A2:D100").Rows
' キーを抽出（例：カテゴリ=A列、日付=B列、部署=C列、値=D列）
keyCat = r.Cells(1, 1).Value
keyMonth = Format(r.Cells(1, 2).Value, "YYYY/MM")
keyDept = r.Cells(1, 3).Value
val = r.Cells(1, 4).Value
' カテゴリ階層が存在しなければ追加
If Not dictCat.Exists(keyCat) Then
Set dictCat(keyCat) = CreateObject("Scripting.Dictionary")
End If
' 月階層が存在しなければ追加
Set dictMonth = dictCat(keyCat)
If Not dictMonth.Exists(keyMonth) Then
Set dictMonth(keyMonth) = CreateObject("Scripting.Dictionary")
End If
' 部署階層が存在しなければ初期化
Set dictDept = dictMonth(keyMonth)
If dictDept.Exists(keyDept) Then
dictDept(keyDept) = dictDept(keyDept) + val
Else
dictDept.Add keyDept, val
End If
Next r
' === 結果出力 ===
Dim pasteRow As Long, cat As Variant, mon As Variant, dept As Variant
pasteRow = 2
For Each cat In dictCat.Keys
For Each mon In dictCat(cat).Keys
For Each dept In dictCat(cat)(mon).Keys
Cells(pasteRow, 6).Value = cat
Cells(pasteRow, 7).Value = mon
Cells(pasteRow, 8).Value = dept
Cells(pasteRow, 9).Value = dictCat(cat)(mon)(dept)
pasteRow = pasteRow + 1
Next dept
Next mon
Next cat
End Sub
応用シナリオ
1. 売上表
- カテゴリ：商品カテゴリ
- 月：売上日付から抽出
- 部署：販売拠点（店舗名）
- 値：売上金額
👉 「カテゴリ × 月 × 店舗別売上」を高速集計
2. 勤怠表
- カテゴリ：社員区分（正社員/アルバイト）
- 月：勤務日付から抽出
- 部署：所属部署
- 値：勤務時間
👉 「社員区分 × 月 × 部署別勤務時間」を高速集計
3. 在庫表
- カテゴリ：商品カテゴリ
- 月：入荷日付から抽出
- 部署：倉庫名
- 値：入荷数
👉 「カテゴリ × 月 × 倉庫別在庫入荷数」を高速集計
✅ 高速化のポイント
- Dictionary → キーごとに即時集計（重複キーは自動加算）
- Collection / Dictionary の入れ子 → 多次元キーを柔軟に表現
- Offset × Resize → 出力先を自在に制御（右側ブロックや下段へ展開）
- 結果出力 → 「カテゴリ・月・部署・集計値」を表形式で展開
💡 この「Dictionary × Collection 多次元集計」パターンを使えば、売上表・勤怠表・在庫表などで カテゴリ × 月 × 部署のクロス集計 を一瞬で処理できます。
