Excel VBA | データ統合(Offset × 条件分岐 × Dictionary)の黄金パターン集

VBA
スポンサーリンク

ここでは 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」パターン集を使えば、売上表・勤怠表・在庫表などの グループ別統合処理 を一瞬で自動化できます。

VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
タイトルとURLをコピーしました