Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – XLOOKUP高速テンプレ

Excel VBA
スポンサーリンク
  1. ねらい：XLOOKUP相当の機能を「配列I/O＋辞書＋二分探索」で爆速・堅牢に再現する
  2. 設計の芯：XLOOKUPの機能を部品に分解して実装する
    1. 方針と機能マップ
    2. 重要ポイントの深掘り
  3. 基本部品：配列I/O、正規化、辞書
    1. 一括I/Oとキー正規化
  4. 完全一致（単一キー・単一返却列）：XLOOKUPの基本を辞書で爆速に
    1. 片側辞書化→一括照合（貼って動く）
    2. 重要ポイントの深掘り
  5. 完全一致（単一キー・複数返却列）：XLOOKUPの「返す列集合」を柔軟に
    1. 選択列をまとめて返却するテンプレ
    2. 重要ポイントの深掘り
  6. 複合キー（2列以上で一意化）：XLOOKUPの柔軟さを辞書で再現
    1. 安全な区切り文字でキーを束ねる（Chr(30)推奨）
    2. 重要ポイントの深掘り
  7. 近似一致（次小/次大）：ソート＋二分探索でXLOOKUPのマッチモードを再現
    1. 二分探索テンプレ（次小/次大を選択）
    2. 重要ポイントの深掘り
  8. 検索方向（先頭/末尾）：最後の一致を取りたいときに
    1. 後方検索（末尾一致優先）
    2. 重要ポイントの深掘り
  9. ワイルドカード（部分一致・前方一致）：パターンで探す
    1. Likeによるパターン検索（最初の一致／全件収集）
    2. 重要ポイントの深掘り
  10. 例題の通し方：顧客コードから顧客名・カテゴリを高速付与、未登録は空に
    1. 単一キー＋複数返却の例
    2. 近似一致の例（ランク区分など）
  11. 運用の深掘り：欠損ポリシー・重複監査・設定外出し
    1. 欠損と重複の扱いを最初に決める
    2. 設定外出しで保守性を上げる
  12. 落とし穴と対策
    1. 正規化不足でヒット漏れ
    2. 未ソートで近似一致が誤動作
    3. 逐次セル書きで遅い
    4. 複数返却列の列ズレ
  13. まとめ：完全一致は辞書、近似は二分探索。配列I/Oと正規化で“速く・壊れない”XLOOKUPを部品化

ねらい：XLOOKUP相当の機能を「配列I/O＋辞書＋二分探索」で爆速・堅牢に再現する

ExcelのXLOOKUPは柔軟ですが、式が増えると管理が重くなり、大量データでは再計算が遅くなります。VBAで「片側辞書化（完全一致）」「二分探索（近似一致）」「複合キー」「複数列返却」「前方/後方検索」「ワイルドカード」を部品化すると、数万〜数十万行でも安定して高速に動き、列変更にも強くなります。ここでは初心者でも貼って動かせる“超再利用テンプレ”を、例題とともにかみ砕いて説明します。

設計の芯：XLOOKUPの機能を部品に分解して実装する

方針と機能マップ

XLOOKUPの「完全一致」「近似一致（次小/次大）」「検索方向（先頭/末尾）」「複数返却列」「ワイルドカード」の5要素を、それぞれ最適なデータ構造で実装します。完全一致は辞書が最速、近似一致は二分探索、後方検索は逆走査、複数返却は配列コピー、ワイルドカードはパターン走査。共通の核は「Range→配列→辞書/探索→結果配列→一括書き戻し」です。

重要ポイントの深掘り

  • 完全一致は「正規化（Trim＋LCase）」を両側に適用して揺らぎをゼロにします。
  • 近似一致は「ソート前提＋二分探索」で線形から対数時間へ。大規模で効きます。
  • 返却は配列で一括書き戻し。逐次セル書きは遅いので避けます。

基本部品：配列I/O、正規化、辞書

一括I/Oとキー正規化

' ModXL_Base.bas
Option Explicit

Public Function ReadRegion(ByVal ws As Worksheet, Optional ByVal topLeft As String = "A1") As Variant
    ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function

Public Sub WriteBlock(ByVal ws As Worksheet, ByVal a As Variant, ByVal topLeft As String)
    ws.Range(topLeft).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Public Function NormKey(ByVal v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v)))
End Function

Public Function NewDict(Optional ByVal textCompare As Boolean = True) As Object
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = IIf(textCompare, 1, 0)
    Set NewDict = d
End Function
VB

完全一致（単一キー・単一返却列）：XLOOKUPの基本を辞書で爆速に

片側辞書化→一括照合（貼って動く）

' ModXL_Exact_Single.bas
Option Explicit

' srcSheet: 参照元（キーはA列）、masterSheet: マスタ（キーA列、返却列B）
' outColLetter: 結果の出力列（例 "Z"）
Public Sub XLookupExact1(ByVal srcSheet As String, ByVal masterSheet As String, ByVal outColLetter As String)
    Dim aS As Variant: aS = ReadRegion(Worksheets(srcSheet))
    Dim aM As Variant: aM = ReadRegion(Worksheets(masterSheet))

    Dim d As Object: Set d = NewDict(True)
    Dim r As Long
    For r = 2 To UBound(aM, 1)
        d(NormKey(aM(r, 1))) = aM(r, 2)
    Next

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "XLOOKUP"
    For r = 2 To UBound(aS, 1)
        Dim k As String: k = NormKey(aS(r, 1))
        out(r, 1) = IIf(d.Exists(k), d(k), "") ' 欠損は空文字（運用に応じて変更）
    Next

    WriteBlock Worksheets(srcSheet), out, outColLetter & "1"
End Sub
VB

重要ポイントの深掘り

  • 1行目はヘッダーとして扱い、2行目から走査すると事故が減ります。
  • 欠損時の値（空/0/N/A）は下流の集計要件に合わせて最初に統一します。

完全一致（単一キー・複数返却列）：XLOOKUPの「返す列集合」を柔軟に

選択列をまとめて返却するテンプレ

' ModXL_Exact_Multi.bas
Option Explicit

' masterはキーA列、返却はcolsCsv（例 "B,D,F"）の複数列
Public Sub XLookupExactMulti(ByVal srcSheet As String, ByVal masterSheet As String, ByVal outStartCol As String, ByVal colsCsv As String)
    Dim aS As Variant: aS = ReadRegion(Worksheets(srcSheet))
    Dim aM As Variant: aM = ReadRegion(Worksheets(masterSheet))

    Dim retIdx() As Long: retIdx = ColsToIndex(colsCsv)
    Dim d As Object: Set d = NewDict(True)
    Dim mapVals As Object: Set mapVals = CreateObject("Scripting.Dictionary") ' key -> Variant()

    Dim r As Long, c As Long
    For r = 2 To UBound(aM, 1)
        Dim k As String: k = NormKey(aM(r, 1))
        Dim pack() As Variant: ReDim pack(1 To UBound(retIdx) + 1)
        For c = 0 To UBound(retIdx)
            pack(c + 1) = aM(r, retIdx(c))
        Next
        mapVals(k) = pack
        d(k) = True
    Next

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To UBound(retIdx) + 1)
    For c = 1 To UBound(retIdx) + 1: out(1, c) = "XLOOKUP_" & c: Next

    For r = 2 To UBound(aS, 1)
        Dim k As String: k = NormKey(aS(r, 1))
        If d.Exists(k) Then
            Dim pack2 As Variant: pack2 = mapVals(k)
            For c = 1 To UBound(pack2): out(r, c) = pack2(c): Next
        Else
            For c = 1 To UBound(retIdx) + 1: out(r, c) = "": Next
        End If
    Next

    WriteBlock Worksheets(srcSheet), out, outStartCol & "1"
End Sub

Private Function ColsToIndex(ByVal csv As String) As Long()
    Dim p() As String: p = Split(csv, ",")
    Dim idx() As Long: ReDim idx(0 To UBound(p))
    Dim i As Long
    For i = 0 To UBound(p): idx(i) = Range(Trim$(p(i)) & "1").Column: Next
    ColsToIndex = idx
End Function
VB

重要ポイントの深掘り

  • 返却列の指定を文字（”B,D,F”）で外出しすれば、列追加・入替にも強い設計になります。
  • 返却値を配列でパックして辞書に保持すると、複数列返却でも辞書ひとつで済み、実装が簡潔です。

複合キー（2列以上で一意化）：XLOOKUPの柔軟さを辞書で再現

安全な区切り文字でキーを束ねる（Chr(30)推奨）

' ModXL_Exact_Composite.bas
Option Explicit
Private Const SEP As String = Chr$(30)

Private Function MakeKey2(ByVal v1 As Variant, ByVal v2 As Variant) As String
    MakeKey2 = NormKey(v1) & SEP & NormKey(v2)
End Function

' master: キーA,B列、返却C列
Public Sub XLookupExact2Keys(ByVal srcSheet As String, ByVal masterSheet As String, ByVal outColLetter As String)
    Dim aS As Variant: aS = ReadRegion(Worksheets(srcSheet))
    Dim aM As Variant: aM = ReadRegion(Worksheets(masterSheet))

    Dim d As Object: Set d = NewDict(True)
    Dim r As Long
    For r = 2 To UBound(aM, 1)
        d(MakeKey2(aM(r, 1), aM(r, 2))) = aM(r, 3)
    Next

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "XLOOKUP2"
    For r = 2 To UBound(aS, 1)
        Dim k As String: k = MakeKey2(aS(r, 1), aS(r, 2))
        out(r, 1) = IIf(d.Exists(k), d(k), "")
    Next

    WriteBlock Worksheets(srcSheet), out, outColLetter & "1"
End Sub
VB

重要ポイントの深掘り

  • 区切りに“ありえない文字”を使って、値の連結による誤結合を防ぎます。
  • 正規化は辞書登録時と参照時の両方で同じ関数を通し、揺らぎを完全に排除します。

近似一致（次小/次大）：ソート＋二分探索でXLOOKUPのマッチモードを再現

二分探索テンプレ（次小/次大を選択）

' ModXL_Approx.bas
Option Explicit

Public Enum MatchMode
    NextSmaller = -1 ' 次小（<=）
    Exact = 0
    NextGreater = 1 ' 次大（>=）
End Enum

' masterは数値キーA列、返却B列。aSは参照元（キーA列）。ソート済み前提。
Public Sub XLookupApprox(ByVal srcSheet As String, ByVal masterSheet As String, ByVal outColLetter As String, ByVal mode As MatchMode)
    Dim aS As Variant: aS = ReadRegion(Worksheets(srcSheet))
    Dim aM As Variant: aM = ReadRegion(Worksheets(masterSheet))

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "XLOOKUP_Approx"

    Dim r As Long
    For r = 2 To UBound(aS, 1)
        Dim key As Double: key = Val(CStr(aS(r, 1)))
        Dim idx As Long: idx = BinSearch(aM, key, mode)
        out(r, 1) = IIf(idx > 0, aM(idx, 2), "")
    Next
    WriteBlock Worksheets(srcSheet), out, outColLetter & "1"
End Sub

Private Function BinSearch(ByVal aM As Variant, ByVal key As Double, ByVal mode As MatchMode) As Long
    Dim lo As Long: lo = 2
    Dim hi As Long: hi = UBound(aM, 1)
    Dim mid As Long

    Do While lo <= hi
        mid = (lo + hi) \ 2
        Dim v As Double: v = Val(CStr(aM(mid, 1)))
        If v = key Then
            BinSearch = mid: Exit Function
        ElseIf v < key Then
            lo = mid + 1
        Else
            hi = mid - 1
        End If
    Loop

    If mode = NextSmaller Then
        BinSearch = IIf(hi >= 2, hi, 0)
    ElseIf mode = NextGreater Then
        BinSearch = IIf(lo <= UBound(aM, 1), lo, 0)
    Else
        BinSearch = 0
    End If
End Function
VB

重要ポイントの深掘り

  • 近似一致は「ソート済み」が前提です。未ソートのまま使わないように、前処理（安定ソート）とセットで運用します。
  • 次小/次大は二分探索の終了位置（lo/hi）を使って即決します。これで O(log n) まで短縮できます。

検索方向（先頭/末尾）：最後の一致を取りたいときに

後方検索（末尾一致優先）

' ModXL_LastMatch.bas
Option Explicit

' masterはキーA、返却B。最後に出現した値を返す。
Public Sub XLookupLast(ByVal srcSheet As String, ByVal masterSheet As String, ByVal outColLetter As String)
    Dim aS As Variant: aS = ReadRegion(Worksheets(srcSheet))
    Dim aM As Variant: aM = ReadRegion(Worksheets(masterSheet))

    Dim d As Object: Set d = NewDict(True)
    Dim r As Long
    For r = 2 To UBound(aM, 1)
        d(NormKey(aM(r, 1))) = aM(r, 2) ' 同じキーが再登場したら上書き＝末尾優先
    Next

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "XLOOKUP_Last"
    For r = 2 To UBound(aS, 1)
        Dim k As String: k = NormKey(aS(r, 1))
        out(r, 1) = IIf(d.Exists(k), d(k), "")
    Next
    WriteBlock Worksheets(srcSheet), out, outColLetter & "1"
End Sub
VB

重要ポイントの深掘り

  • 末尾優先は「辞書上書き」で簡潔に実現できます。先頭優先は「未登録時のみ代入」に切り替えればOKです。
  • 明示的に仕様化しておくと、レビュー時の期待値がブレません。

ワイルドカード（部分一致・前方一致）：パターンで探す

Likeによるパターン検索（最初の一致／全件収集）

' ModXL_Wildcard.bas
Option Explicit

' 例：pattern="ABC*"（前方一致）や "*XYZ*"（包含）
Public Sub XLookupWildcardFirst(ByVal srcSheet As String, ByVal masterSheet As String, ByVal outColLetter As String, ByVal patternCol As Long, ByVal retCol As Long)
    Dim aS As Variant: aS = ReadRegion(Worksheets(srcSheet))
    Dim aM As Variant: aM = ReadRegion(Worksheets(masterSheet))

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "XLOOKUP_Wildcard"

    Dim rS As Long, rM As Long
    For rS = 2 To UBound(aS, 1)
        Dim pattern As String: pattern = CStr(aS(rS, 1)) ' 参照側にパターン
        Dim found As String: found = ""
        For rM = 2 To UBound(aM, 1)
            If LCase$(CStr(aM(rM, patternCol))) Like LCase$(pattern) Then
                found = CStr(aM(rM, retCol)): Exit For
            End If
        Next
        out(rS, 1) = found
    Next
    WriteBlock Worksheets(srcSheet), out, outColLetter & "1"
End Sub
VB

重要ポイントの深掘り

  • ワイルドカードは辞書に載せづらいので、走査で割り切ります。件数が多い場合はマスタ側をインデックス（前方一致ならTrieなど）にする拡張も可能です。
  • 大文字・小文字の揺らぎを消すため、両側を LCase で比較します。

例題の通し方：顧客コードから顧客名・カテゴリを高速付与、未登録は空に

単一キー＋複数返却の例

' ModXL_Example.bas
Option Explicit

Public Sub Demo_XLookupExactMulti()
    ' Data: A列=顧客コード
    ' Master: A列=顧客コード, B列=顧客名, D列=カテゴリ（C列は別用途として飛ばす例）
    XLookupExactMulti "Data", "Master", "Z", "B,D"
    MsgBox "顧客名・カテゴリを高速付与しました。", vbInformation
End Sub
VB

近似一致の例（ランク区分など）

Public Sub Demo_XLookupApprox()
    ' RankMasterはA列=しきい値（昇順）、B列=区分名
    XLookupApprox "Scores", "RankMaster", "Z", NextSmaller
    MsgBox "区分を付与しました（次小マッチ）。", vbInformation
End Sub
VB

運用の深掘り：欠損ポリシー・重複監査・設定外出し

欠損と重複の扱いを最初に決める

欠損は空文字/0/N/Aのどれにするか、重複キー（マスタ側）の検出を行うかを最初に仕様化します。辞書化前に d.Exists(key) で検出し、警告リストを作ると品質が上がります。

設定外出しで保守性を上げる

シート名、出力列、返却列集合、近似モードなどは config.ini に外出しすると、非エンジニアでも安全に切り替えできます。コード側には既定値を持たせ、設定が欠けても動くようにします。

落とし穴と対策

正規化不足でヒット漏れ

Trim/LCaseの正規化を辞書登録時と参照時の両方に適用します。全半角統一が必要な現場では前処理を足します。

未ソートで近似一致が誤動作

二分探索はソート前提。前処理で安定ソート→探索の流れを徹底します。

逐次セル書きで遅い

必ず配列で結果を作り、一括書き戻しにします。これだけで速度が桁違いに改善します。

複数返却列の列ズレ

返却列の指定を文字（”B,D,F”）で管理し、列追加・変更に強い設計にします。ヘッダー行は必ず1行目固定で扱います。

まとめ：完全一致は辞書、近似は二分探索。配列I/Oと正規化で“速く・壊れない”XLOOKUPを部品化

  • 完全一致は辞書で爆速、複数返却・複合キーも配列＋辞書で簡潔に。
  • 近似一致はソート＋二分探索で対数時間。検索方向（先頭/末尾）やワイルドカードも部品化。
  • 欠損/重複/設定外出しを最初に決め、配列一括書き戻しで運用を強くする。

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