Excel VBA | 検証＋統合（Offset × 条件分岐 × Replace × Split × Format × Dictionary）の黄金パターン集

VBA
スポンサーリンク

ここでは Offset × 条件分岐 × Replace × Split × Format × Dictionary を組み合わせて「セルの値を検証 → 不要文字を置換 → 分割 → フォーマット統一 → キーごとに統合」まで一気通貫で処理する黄金パターンをまとめます。
これにより、売上表・勤怠表・在庫表などの 複合データの正規化＋統合集計 を VBA で自動化できます。

基本パターン 10選

1. 商品コード検証＋Replace＋Split＋統合

Dim dict As Object, r As Range, parts As Variant
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("A2:B20").Rows
    If r.Cells(1, 1).Value <> "" And InStr(r.Cells(1, 1).Value, "-") > 0 Then
        parts = Split(Replace(r.Cells(1, 1).Value, " ", ""), "-")
        Dim key As String
        key = UCase(parts(0)) & "-" & Format(parts(1), "0000")
        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

👉 商品コードを正規化して売上統合。

2. 部署名検証＋Trim＋統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("C2:D20").Rows
    If r.Cells(1, 1).Value <> "" And IsNumeric(r.Cells(1, 2).Value) Then
        Dim key As String
        key = Trim(r.Cells(1, 1).Value)
        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

👉 部署名をTrimで整形して勤務時間統合。

3. 日付検証＋Format＋月別統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("E2:F20").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

👉 日付を「YYYY/MM」に正規化して月別売上統合。

4. 顧客名検証＋Replace＋購入回数統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("G2:H20").Rows
    If r.Cells(1, 1).Value <> "" Then
        Dim key As String
        key = Replace(r.Cells(1, 1).Value, "NG", "※")
        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict.Add key, 1
        End If
    End If
Next r
VB

👉 顧客名のNGワードを置換して購入回数統合。

5. 在庫数検証＋Format＋商品別統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("I2:J20").Rows
    If IsNumeric(r.Cells(1, 2).Value) Then
        Dim key As String
        key = r.Cells(1, 1).Value
        If dict.Exists(key) Then
            dict(key) = dict(key) + r.Cells(1, 2).Value
        Else
            dict.Add key, Format(r.Cells(1, 2).Value, "0")
        End If
    End If
Next r
VB

👉 在庫数を数値フォーマットで統一して商品別統合。

6. 社員名検証＋ProperCase＋遅刻回数統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("K2:L20").Rows
    If IsDate(r.Cells(1, 2).Value) And Hour(r.Cells(1, 2).Value) > 9 Then
        Dim key As String
        key = StrConv(r.Cells(1, 1).Value, vbProperCase)
        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict.Add key, 1
        End If
    End If
Next r
VB

👉 社員名をProperCaseに整形して遅刻回数統合。

7. エラー種別検証＋Trim＋件数統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("M2:M20")
    If r.Value <> "" Then
        Dim key As String
        key = Trim(r.Value)
        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict.Add key, 1
        End If
    End If
Next r
VB

👉 エラー種別をTrimで整形して件数統合。

8. タグ検証＋Split＋件数統合

Dim dict As Object, r As Range, parts As Variant, i As Integer
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("N2:N20")
    If InStr(r.Value, ",") > 0 Then
        parts = Split(r.Value, ",")
        For i = LBound(parts) To UBound(parts)
            Dim key As String
            key = Trim(parts(i))
            If dict.Exists(key) Then
                dict(key) = dict(key) + 1
            Else
                dict.Add key, 1
            End If
        Next i
    End If
Next r
VB

👉 タグをSplitで分割し、件数統合。

9. VIP顧客検証＋Replace＋売上統合

Dim dict As Object, r As Range
Set dict = CreateObject("Scripting.Dictionary")

For Each r In Range("O2:Q20").Rows
    If r.Cells(1, 3).Value = "VIP" Then
        Dim key As String
        key = Replace(r.Cells(1, 1).Value, " ", "")
        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

👉 VIP顧客のみ売上を統合。

10. 統合結果を表形式で出力

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

👉 Dictionaryで統合した結果を表形式で出力。

✅ まとめ

  • Offset → 統合結果を隣列や下段へ展開
  • 条件分岐 → 空欄判定・VIP判定・数値/日付判定などで対象を絞り込み
  • Replace → 不要文字や表記揺れを削除
  • Split → 複合データを分割して正規化
  • Format → 数値・日付・文字列を統一フォーマット化
  • Dictionary → キーごとにデータを統合・集計
  • 黄金パターン → 商品別・部署別・月別・顧客別・タグ別などの統合＋正規化処理を高速化

💡 この「検証＋統合 × Offset × 条件分岐 × Replace × Split × Format × Dictionary」パターン集を使えば、
データクレンジング → 正規化 → 統合 → 集計 を一瞬で自動化できます。

スポンサーリンク
タイトルとURLをコピーしました