Excel VBA 逆引き集 | 最適な検索戦略（辞書）

Excel VBA
スポンサーリンク

最適な検索戦略（辞書）

大量データの「爆速検索・照合・集計」は、辞書（Scripting.Dictionary）の独壇場。キーに対して O(1) で存在判定・値取得ができ、重複排除や複合キー、グルーピングが一発で決まります。初心者でも迷わないテンプレと、現場で壊れない実装のコツをまとめました。

まずは辞書の基本（最短で動かす）

'参照設定不要（Late Binding）—配布に強い
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

dict.Add "A001", "田中"   '追加
If dict.Exists("A001") Then Debug.Print dict("A001") '取得
dict.Remove "A001"        '削除
dict.RemoveAll            '全削除
VB
  • 追加/取得/存在判定/削除: Add、Item（dict(key)）、Exists、Remove が基本。キーは重複不可なので、同じキーに再追加は失敗します。
  • 補完を効かせたい場合: 参照設定「Microsoft Scripting Runtime」を有効化し、Dim dict As New Scripting.Dictionary と書けば型補完が効きます（環境配布が伴うため、迷ったら Late Binding が無難）。

キーを正規化して「壊れない」爆速検索

'キーの揺れ対策テンプレ（数値/文字列/大小文字/全角半角を統一）
Private Function KeyNorm(ByVal v As Variant) As String
    KeyNorm = UCase$(CStr(v))  '例：文字列化＋大文字化（必要なら StrConv で半角統一）
End Function
VB
  • おすすめ正規化: CStr（文字列化）＋UCase（大小文字統一）。品番やIDの型揺れ、先頭ゼロの崩れを防げます。日本語混在では StrConv（vbNarrow/vbWide）も有効です。

定番テンプレート（即コピペで実務投入）

1. マスタ照合（VLOOKUP/XLOOKUP相当を辞書で爆速）

Sub DictLookup_MasterToDetail()
    Dim m As Range: Set m = Worksheets("Master").Range("A2:C" & Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row)
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

    'キー=A列、戻り値は配列（B,C）
    Dim i As Long, v As Variant: v = m.Value
    For i = 1 To UBound(v, 1)
        dict(KeyNorm(v(i, 1))) = Array(v(i, 2), v(i, 3))
    Next

    '明細側：A（キー）→B,Cに貼り付け
    Dim d As Range: Set d = Worksheets("Detail").Range("A2:C" & Worksheets("Detail").Cells(Rows.Count, "A").End(xlUp).Row)
    Dim w As Variant: w = d.Value
    For i = 1 To UBound(w, 1)
        Dim k As String: k = KeyNorm(w(i, 1))
        If dict.Exists(k) Then
            w(i, 2) = dict(k)(0)
            w(i, 3) = dict(k)(1)
        Else
            w(i, 2) = "": w(i, 3) = ""
        End If
    Next
    d.Value = w
End Sub
VB
  • ポイント: キーの正規化で取りこぼしを防止。範囲→配列→辞書→配列書き戻しが最速の基本形です。

2. 重複検出・ユニーク抽出（一瞬）

Sub DictUnique()
    Dim src As Range: Set src = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim v As Variant: v = src.Value
    Dim i As Long
    For i = 1 To UBound(v, 1)
        dict(KeyNorm(v(i, 1))) = True  'キー重複不可→自動ユニーク
    Next
    'ユニークキー一覧をD列へ
    Dim keys As Variant: keys = dict.Keys
    Range("D2").Resize(UBound(keys) + 1, 1).Value = Application.Transpose(keys)
End Sub
VB
  • ポイント: 「辞書はキー重複不可」なので、追加しただけでユニーク化が完了。AdvancedFilter の代替としても使えます。

3. 複合キー（複数列で一致判定）

Sub DictCompositeKey()
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim r As Long, K As String

    For r = 2 To last
        K = KeyNorm(Cells(r, "A").Value) & "|" & Format$(Cells(r, "B").Value, "yyyymmdd") 'A+日付
        If dict.Exists(K) Then
            Rows(r).Interior.Color = RGB(255, 235, 156) '重複行
        Else
            dict.Add K, True
        End If
    Next
End Sub
VB
  • ポイント: 区切りは存在しない文字（例：”|”）を使い、日付は yyyymmdd へ正規化すると安全です。

検索の拡張パターン（集計・多値対応・逆引き）

  • 件数集計（頻度カウント）
    • 用途: 重複頻度やカテゴリ件数の集計。辞書はキーと値のペアで管理するため、カウンタ用途に最適です。
If dict.Exists(k) Then dict(k) = dict(k) + 1 Else dict.Add k, 1
VB
  • 多値格納（キー→複数行）
    • 用途: 同一キーの全行を後でまとめて処理。Dictionary＋Collection で「マルチマップ」風に扱えます。
If Not dict.Exists(k) Then dict.Add k, New Collection
dict(k).Add r  '行番号を溜める
VB
  • 逆引き（値→キー）の二方向マップ
    • 用途: 「片方からもう片方へ」即アクセス。キー重複不可の特性を利用します。
'正引き: code→name、逆引き: name→code
dict1(code) = name
dict2(name) = code
VB

高速テンプレと安全ラップ

Sub SpeedWrapStart()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Sub SpeedWrapEnd()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • 使い方: 取り込み前後に挟むだけで体感が段違い。エラー時も必ず復帰するよう Cleanup を設けると安全です（辞書はメモリ上のオブジェクトなので、Close は不要）。

例題で練習

例題1：社員ID→氏名＋部署の高速照合

Sub Example_IdLookup()
    Dim m As Range: Set m = Worksheets("Master").Range("A2:C" & Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row)
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim v As Variant: v = m.Value, i As Long
    For i = 1 To UBound(v, 1)
        dict(KeyNorm(v(i, 1))) = Array(v(i, 2), v(i, 3))
    Next

    Dim d As Range: Set d = Worksheets("Detail").Range("A2:C" & Worksheets("Detail").Cells(Rows.Count, "A").End(xlUp).Row)
    Dim w As Variant: w = d.Value
    For i = 1 To UBound(w, 1)
        Dim k As String: k = KeyNorm(w(i, 1))
        If dict.Exists(k) Then w(i, 2) = dict(k)(0): w(i, 3) = dict(k)(1) Else w(i, 2) = "": w(i, 3) = ""
    Next
    d.Value = w
End Sub
VB

例題2：品番のユニーク一覧＋件数集計

Sub Example_UniqueAndCount()
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Dim r As Long, k As String
    For r = 2 To last
        k = KeyNorm(Cells(r, "A").Value)
        If dict.Exists(k) Then dict(k) = dict(k) + 1 Else dict.Add k, 1
    Next
    '出力（品番/件数）
    Dim keys As Variant: keys = dict.Keys
    Dim i As Long
    For i = 0 To UBound(keys)
        Cells(i + 2, "D").Value = keys(i)
        Cells(i + 2, "E").Value = dict(keys(i))
    Next
End Sub
VB

例題3：顧客コード＋日付の複合キーで重複行を抽出

Sub Example_ExtractDuplicatesComposite()
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim out As Worksheet: Set out = Worksheets("抽出")
    Dim outRow As Long: outRow = 2
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Dim r As Long, key As String

    For r = 2 To last
        key = KeyNorm(Cells(r, "A").Value) & "|" & Format$(Cells(r, "B").Value, "yyyymmdd")
        If dict.Exists(key) Then
            Rows(r).Copy Destination:=out.Rows(outRow)
            outRow = outRow + 1
        Else
            dict.Add key, True
        End If
    Next
End Sub
VB

よくある落とし穴と対策

  • キー重複で Add がエラーになる:
    • 対策: 事前に If dict.Exists(k) Then ... Else dict.Add k, v。上書きしたいなら dict(k) = v。
  • 型揺れ（”00123″ と 123）が別扱いになる:
    • 対策: 取り込み直後に CStr＋UCase（必要なら半角化）で KeyNorm を通す。
  • 複数値を持ちたいのに上書きしてしまう:
    • 対策: 値に Array(...) や Collection を使い、多値格納（マルチマップ化）。
  • 辞書とコレクションの使い分けが曖昧:
    • 対策: キーで直接引きたい・高速存在判定→Dictionary。順序重視・重複許容→Collection。
  • 配列なしでセルを行ごとに読むため遅い:
    • 対策: 範囲を一度 Variant 配列に読み込み→辞書→一括書き戻しが鉄板。これだけで桁違いに速くなります。
スポンサーリンク
タイトルとURLをコピーしました