最適な検索戦略（辞書）
大量データの「爆速検索・照合・集計」は、辞書（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 '全削除
- 追加/取得/存在判定/削除: 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
- おすすめ正規化: 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
- ポイント: キーの正規化で取りこぼしを防止。範囲→配列→辞書→配列書き戻しが最速の基本形です。
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
- ポイント: 「辞書はキー重複不可」なので、追加しただけでユニーク化が完了。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
- ポイント: 区切りは存在しない文字（例：”|”）を使い、日付は yyyymmdd へ正規化すると安全です。
検索の拡張パターン（集計・多値対応・逆引き）
- 件数集計（頻度カウント）
- 用途: 重複頻度やカテゴリ件数の集計。辞書はキーと値のペアで管理するため、カウンタ用途に最適です。
If dict.Exists(k) Then dict(k) = dict(k) + 1 Else dict.Add k, 1
- 多値格納（キー→複数行）
- 用途: 同一キーの全行を後でまとめて処理。Dictionary＋Collection で「マルチマップ」風に扱えます。
If Not dict.Exists(k) Then dict.Add k, New Collection
dict(k).Add r '行番号を溜める
- 逆引き（値→キー）の二方向マップ
- 用途: 「片方からもう片方へ」即アクセス。キー重複不可の特性を利用します。
'正引き: code→name、逆引き: name→code
dict1(code) = name
dict2(name) = code
高速テンプレと安全ラップ
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
- 使い方: 取り込み前後に挟むだけで体感が段違い。エラー時も必ず復帰するよう 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
例題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
例題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
よくある落とし穴と対策
- キー重複で Add がエラーになる:
- 対策: 事前に
If dict.Exists(k) Then ... Else dict.Add k, v。上書きしたいならdict(k) = v。
- 対策: 事前に
- 型揺れ（”00123″ と 123）が別扱いになる:
- 対策: 取り込み直後に CStr＋UCase（必要なら半角化）で KeyNorm を通す。
- 複数値を持ちたいのに上書きしてしまう:
- 対策: 値に
Array(...)やCollectionを使い、多値格納（マルチマップ化）。
- 対策: 値に
- 辞書とコレクションの使い分けが曖昧:
- 対策: キーで直接引きたい・高速存在判定→Dictionary。順序重視・重複許容→Collection。
- 配列なしでセルを行ごとに読むため遅い:
- 対策: 範囲を一度
Variant配列に読み込み→辞書→一括書き戻しが鉄板。これだけで桁違いに速くなります。
- 対策: 範囲を一度