Excel VBA | データ統合+正規化(Offset × 条件分岐 × Dictionary × Replace × Split × Format)の黄金パターン集

Excel VBA VBA
スポンサーリンク

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


基本パターン 10選

1. 商品カテゴリ別売上統合+コード整形

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 <> "" 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. 月別売上統合+日付フォーマット

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. 顧客別購入回数統合+NGワード置換

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. 商品別在庫統合+数値フォーマット

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. 社員別遅刻回数統合+時刻フォーマット

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顧客売上統合+条件分岐

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判定・数値/日付判定などを組み合わせ
  • Dictionary → キーごとに即時集計・統合
  • Replace → 不要文字や表記揺れを削除
  • Split → 複合データを分割して正規化
  • Format → 数値・日付・文字列を統一フォーマット化
  • 黄金パターン → 商品別・部署別・月別・顧客別・タグ別などの統合+正規化処理を高速化

この複合黄金パターンの強み

  • 検証+整形+補完+正規化+統合 を一括で処理できるため、実務でのデータ品質を一気に改善
  • 柔軟性:条件分岐で「空欄なら補完」「入力済みなら整形」「特定条件なら統合」と切り替え可能
  • 汎用性:売上表・勤怠表・在庫表・顧客リストなど、あらゆる業務データに適用可能
  • 再利用性:Replace・Split・Format・IfEmpty・Dictionary の組み合わせをテンプレ化すれば、どんなデータでも即対応

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

タイトルとURLをコピーしました