ここでは Offset × 条件分岐 × Dictionary を組み合わせて「複数セルのデータを検証し、カテゴリごとに統合・集計する」黄金パターンをまとめます。
Dictionary を活用することで、重複データやグループ別集計を高速に処理できます。
基本パターン 10選
1. カテゴリ別売上統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("A2:B20").Rows
If r.Cells(1, 1).Value <> "" Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + r.Cells(1, 2).Value
Else
dict.Add r.Cells(1, 1).Value, r.Cells(1, 2).Value
End If
End If
Next r
VB👉 商品カテゴリごとに売上金額を統合。
2. 部署別勤務時間統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("C2:D20").Rows
If IsNumeric(r.Cells(1, 2).Value) Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + r.Cells(1, 2).Value
Else
dict.Add r.Cells(1, 1).Value, r.Cells(1, 2).Value
End If
End If
Next r
VB👉 部署ごとの勤務時間を統合。
3. 倉庫別在庫統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("E2:F20").Rows
If IsNumeric(r.Cells(1, 2).Value) Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + r.Cells(1, 2).Value
Else
dict.Add r.Cells(1, 1).Value, r.Cells(1, 2).Value
End If
End If
Next r
VB👉 倉庫ごとの在庫数を統合。
4. 月別売上統合(条件分岐で日付判定)
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("A2:C20").Rows
If IsDate(r.Cells(1, 1).Value) Then
Dim key As String
key = Format(r.Cells(1, 1).Value, "YYYY/MM")
If dict.Exists(key) Then
dict(key) = dict(key) + r.Cells(1, 2).Value
Else
dict.Add key, r.Cells(1, 2).Value
End If
End If
Next r
VB👉 日付から月を抽出して売上を統合。
5. エラー種別件数統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("B2:B20")
If r.Value <> "" Then
If dict.Exists(r.Value) Then
dict(r.Value) = dict(r.Value) + 1
Else
dict.Add r.Value, 1
End If
End If
Next r
VB👉 エラー種別ごとの件数を統合。
6. 社員別遅刻回数統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("C2:D20").Rows
If IsDate(r.Cells(1, 2).Value) And Hour(r.Cells(1, 2).Value) > 9 Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + 1
Else
dict.Add r.Cells(1, 1).Value, 1
End If
End If
Next r
VB👉 社員ごとの遅刻回数を統合。
7. 商品別在庫異常統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("E2:F20").Rows
If IsNumeric(r.Cells(1, 2).Value) And r.Cells(1, 2).Value < 0 Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + 1
Else
dict.Add r.Cells(1, 1).Value, 1
End If
End If
Next r
VB👉 商品ごとの負在庫件数を統合。
8. 顧客別購入回数統合
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("A2:B20").Rows
If r.Cells(1, 1).Value <> "" Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + 1
Else
dict.Add r.Cells(1, 1).Value, 1
End If
End If
Next r
VB👉 顧客ごとの購入回数を統合。
9. 条件付き売上統合(VIP顧客のみ)
Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each r In Range("A2:C20").Rows
If r.Cells(1, 3).Value = "VIP" Then
If dict.Exists(r.Cells(1, 1).Value) Then
dict(r.Cells(1, 1).Value) = dict(r.Cells(1, 1).Value) + r.Cells(1, 2).Value
Else
dict.Add r.Cells(1, 1).Value, r.Cells(1, 2).Value
End If
End If
Next r
VB👉 VIP顧客のみ売上を統合。
10. 出力(Dictionary → 表形式)
Dim k As Variant, pasteRow As Long
pasteRow = 30
For Each k In dict.Keys
Cells(pasteRow, 1).Value = k
Cells(pasteRow, 2).Value = dict(k)
pasteRow = pasteRow + 1
Next k
VB👉 統合結果を表形式で出力。
✅ まとめ
- Offset → 隣列や下段に結果を出力
- 条件分岐 → 数値判定・日付判定・特定条件(VIPなど)でフィルタリング
- Dictionary → キーごとに即時集計・統合
- 黄金パターン → カテゴリ別・月別・部署別・顧客別などの統合処理を高速化
💡 この「データ統合 × Offset × 条件分岐 × Dictionary」パターン集を使えば、売上表・勤怠表・在庫表などの グループ別統合処理 を一瞬で自動化できます。

