Excel VBA 逆引き集 | VLOOKUP 相当をVBAで

Excel VBA
スポンサーリンク

VLOOKUP 相当をVBAで

シートの関数に頼らず「コードだけで照合・抽出」できると、崩れにくくて速い。初心者でもすぐ使える4つの定番手法と、業務で耐える安全テンプレをまとめました。

選び方の指針

  • 小規模・簡単に済ませたい: WorksheetFunction.VLookup（最短）
  • 大量データを爆速で処理したい: Dictionary（O(1)検索）
  • 曖昧一致や部分一致がほしい: Range.Find（検索オプションが豊富）
  • 列計算を式で一気に作りたい: Evaluate（VBAループ不要）

1. 最短：WorksheetFunction.VLookup を使う

Sub VLookup_Basic()
    Dim key As Variant, table As Range, col As Long, result As Variant
    key = Range("A2").Value                     '検索値
    Set table = Range("D2:F100")                '検索範囲（左端列にキー）
    col = 3                                      '範囲内の列番号（1=左端）

    On Error Resume Next                         '見つからない時の #N/A 対策
    result = Application.WorksheetFunction.VLookup(key, table, col, False)
    On Error GoTo 0

    If IsError(result) Or IsEmpty(result) Then
        Range("B2").Value = ""                   '未一致時の扱い
    Else
        Range("B2").Value = result
    End If
End Sub
VB
  • ポイント:
    • False（完全一致）を使うのが基本。
    • 見つからないと実行時エラーになるため、On Error でガードする。
    • 参照表の左端列がキーである必要がある（VLOOKUPの仕様そのまま）。

2. 業務定番：Dictionary で爆速ルックアップ

単価マスタを辞書化 → 明細に照合

Sub VLookup_Dictionary()
    '高速化ラップ（任意）
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    '辞書にマスタを読み込み（コード→単価）
    Dim price As Object: Set price = CreateObject("Scripting.Dictionary")
    Dim wsM As Worksheet: Set wsM = Worksheets("Master")
    Dim mLast As Long: mLast = wsM.Cells(wsM.Rows.Count, "A").End(xlUp).Row
    Dim r As Long
    For r = 2 To mLast
        price(CStr(wsM.Cells(r, "A").Value)) = wsM.Cells(r, "B").Value
    Next

    '明細は配列で一括処理（C:コード D:数量 E:金額）
    Dim wsD As Worksheet: Set wsD = Worksheets("Detail")
    Dim last As Long: last = wsD.Cells(wsD.Rows.Count, "C").End(xlUp).Row
    Dim rg As Range: Set rg = wsD.Range("C2:E" & last)
    Dim v As Variant: v = rg.Value

    Dim i As Long, code As String, qty As Double
    For i = 1 To UBound(v, 1)
        code = CStr(v(i, 1))
        qty = Val(v(i, 2))
        If price.Exists(code) Then
            v(i, 3) = qty * price(code)
        Else
            v(i, 3) = ""                         '未一致時の扱い
        End If
    Next

    rg.Value = v

    '復帰
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 10万件規模でも耐える高速照合。
    • キー型は混在しがちなので、辞書登録・照合ともに CStr で統一が安全。
    • 値は配列に読み込み→計算→一括書き戻しが最速。

3. 部分一致や柔軟検索：Range.Find

Sub VLookup_Find()
    Dim key As String: key = Range("A2").Value
    Dim lookCol As Range: Set lookCol = Range("D2:D10000") 'キー列
    Dim f As Range

    Set f = lookCol.Find(What:=key, LookIn:=xlValues, LookAt:=xlWhole) '完全一致
    If Not f Is Nothing Then
        Range("B2").Value = f.Offset(0, 2).Value  '見つかった行の +2列（例：F列）を取得
    Else
        Range("B2").Value = ""
    End If
End Sub
VB
  • ポイント:
    • LookAt:=xlWhole（完全一致）、xlPart（部分一致）。
    • 検索方向や大小文字区別など、オプション調整が可能。
    • 一件ずつ探す処理に向く（大量一括は辞書が向く）。

4. 列まるごと式で一気に：Evaluate

Sub VLookup_Evaluate()
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Range("B2:B" & last).Formula = "=IFERROR(VLOOKUP(A2,$D$2:$F$1000,3,FALSE),"""")"
    '必要なら値化
    Range("B2:B" & last).Value = Range("B2:B" & last).Value
End Sub
VB
  • ポイント:
    • セルに式を埋めて一括計算→必要なら値化。
    • 再計算負荷が高いブックでは、計算モードを手動にして最後に1回再計算すると安定。

安全テンプレート（一括処理の土台）

Sub VLookup_SafeWrap_ApplyDict()
    Dim scr As Boolean: scr = Application.ScreenUpdating
    Dim ev As Boolean: ev = Application.EnableEvents
    Dim calc As XlCalculation: calc = Application.Calculation
    On Error GoTo Cleanup

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    '=== ここに辞書照合などの本処理を差し込む ===

Cleanup:
    Application.Calculation = calc
    Application.EnableEvents = ev
    Application.ScreenUpdating = scr
End Sub
VB
  • ポイント:
    • 設定を退避→復帰はテンプレ化して事故防止。
    • 途中エラーでも元に戻る。

例題で練習

例題1：社員ID→氏名を辞書照合してB列へ

Sub Example_IdToName()
    Dim nameMap As Object: Set nameMap = CreateObject("Scripting.Dictionary")
    Dim mLast As Long, r As Long
    With Worksheets("Master")
        mLast = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = 2 To mLast
            nameMap(CStr(.Cells(r, "A").Value)) = .Cells(r, "B").Value
        Next
    End With

    Dim dLast As Long: dLast = Cells(Rows.Count, "A").End(xlUp).Row
    Dim rg As Range: Set rg = Range("A2:B" & dLast)
    Dim v As Variant: v = rg.Value
    Dim i As Long, id As String
    For i = 1 To UBound(v, 1)
        id = CStr(v(i, 1))
        If nameMap.Exists(id) Then
            v(i, 2) = nameMap(id)
        Else
            v(i, 2) = ""
        End If
    Next
    rg.Value = v
End Sub
VB

例題2：商品コードの前方一致で最初のマッチをFind

Sub Example_PrefixMatch()
    Dim codePrefix As String: codePrefix = Range("A2").Value
    Dim f As Range
    Set f = Range("D2:D20000").Find(What:=codePrefix, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
    Range("B2").Value = IIf(f Is Nothing, "", f.Offset(0, 1).Value)
End Sub
VB

例題3：式でVLOOKUP→必要列だけ値化

Sub Example_VLookupFormulaToValues()
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    With Range("B2:B" & last)
        .Formula = "=IFERROR(VLOOKUP(A2,$G$2:$H$10000,2,FALSE),"""")"
        .Value = .Value
    End With
End Sub
VB

よくある落とし穴と対策

  • キー列が左端でない（VLOOKUP不可）:
    • 対策: 辞書、Find、INDEX/MATCH（式）に切り替え。辞書ならどの列でもキーにできる。
  • 見つからない時のエラー停止（WorksheetFunction）:
    • 対策: On Error でガードし、未一致時の代替値（空文字など）を決めておく。
  • 型混在（”00123″ と 123 が別物）:
    • 対策: キーは CStr で統一。マスタ登録時と照合時で同じ型に。
  • 大量データで遅い:
    • 対策: 配列一括＋辞書。セル個別アクセスや1件ごとVLOOKUPは避ける。
  • 再計算・イベントの暴発:
    • 対策: 処理前に ScreenUpdating/EnableEvents/Calculation を一時停止し、最後に復帰。
  • 部分一致の誤ヒット:
    • 対策: FindのLookAtを適切に。部分一致で複数候補がある場合は FindNext で全件列挙し、条件で絞る。

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