Excel VBA 逆引き集 | 列名で検索

Excel VBA
スポンサーリンク

列名で検索

「見出し行から“この列どこ？”を素早く特定したい」—業務で頻出のニーズを、初心者でも安心して使える定番テンプレでまとめました。Find、MATCH、Dictionary化、自作関数まで、使い分けと落とし穴対策もセットです。

使い分けの指針

  • 最短かつ柔軟: Range.Find（完全一致・部分一致・大小文字指定ができる）
  • 位置番号で取りたい: WorksheetFunction.Match（完全一致で安定）
  • 複数列名を何度も参照: Dictionaryに見出し→列番号をキャッシュ
  • どこでも呼べる再利用: 列名→列番号の自作関数（安全版）

基本：Findで列名を探して列番号を取得

Sub FindHeaderColumn_Basic()
    Dim headerRow As Range, hit As Range, colNo As Long
    Set headerRow = Range("A1:Z1")  '見出し行の範囲
    Set hit = headerRow.Find(What:="単価", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    If Not hit Is Nothing Then
        colNo = hit.Column                    'シート上の列番号（A=1, B=2, ...）
        Cells(2, colNo).Value = "ここに結果"  '列番号が分かれば参照は簡単
    Else
        MsgBox "列名が見つかりません: 単価", vbExclamation
    End If
End Sub
VB
  • ポイント:
    • 完全一致は xlWhole、部分一致は xlPart。
    • 値検索（xlValues）を基本に。数式文字列を探すなら xlFormulas。
    • hit.Column はワークシートの実列番号。Range内の相対位置ではない。

安定派：MATCHで列名の位置を取り、列番号へ換算

Sub MatchHeader_ToColumn()
    Dim pos As Variant, headerRow As Range, startCol As Long, colNo As Long
    Set headerRow = Range("A1:Z1")           '見出し行
    startCol = headerRow.Column               '範囲の開始列番号（A=1など）

    On Error Resume Next
    pos = Application.WorksheetFunction.Match("単価", headerRow, 0)  '0=完全一致
    On Error GoTo 0

    If Not IsError(pos) Then
        colNo = startCol + CLng(pos) - 1     '範囲内位置→シート列番号へ換算
        Cells(2, colNo).Value = "ここに結果"
    Else
        MsgBox "列名が見つかりません: 単価", vbExclamation
    End If
End Sub
VB
  • ポイント:
    • MATCHは「範囲内の位置」を返すので、開始列を足して列番号へ換算。
    • 近似一致（1/-1）は並べ替えが必要。見出しには使わず「0（完全一致）」を使う。

実務定番：見出し→列番号をDictionaryにキャッシュ

Sub BuildHeaderMap_AndUse()
    Dim header As Range: Set header = Range("A1").CurrentRegion.Rows(1) '先頭行を見出しと想定
    Dim i As Long, map As Object: Set map = CreateObject("Scripting.Dictionary")

    '見出し行を辞書化（キー=列名、値=列番号）
    For i = 1 To header.Columns.Count
        map(CStr(header.Cells(1, i).Value)) = header.Cells(1, i).Column
    Next

    '使うときはキーで参照
    If map.Exists("単価") Then
        Cells(2, map("単価")).Value = "ここに結果"
    Else
        MsgBox "列名が見つかりません: 単価", vbExclamation
    End If
End Sub
VB
  • ポイント:
    • 何度も列名参照する処理を「爆速」に。1回作った辞書を使い回す。
    • 型の揺れ対策: キー登録時は CStr で文字列化が安全。

再利用できる安全関数：列名→列番号を返す

Function GetColumnByHeader(ByVal headerName As String, ByVal headerRange As Range, _
                           Optional ByVal partial As Boolean = False, _
                           Optional ByVal matchCase As Boolean = False) As Long
    Dim hit As Range, lookAt As XlLookAt
    lookAt = IIf(partial, xlPart, xlWhole)

    Set hit = headerRange.Find(What:=headerName, LookAt:=lookAt, LookIn:=xlValues, MatchCase:=matchCase)
    If Not hit Is Nothing Then
        GetColumnByHeader = hit.Column
    Else
        GetColumnByHeader = 0   '0を未検出のシグナルに
    End If
End Function

'使い方例
Sub Use_GetColumnByHeader()
    Dim colNo As Long
    colNo = GetColumnByHeader("単価", Range("A1:Z1"))
    If colNo > 0 Then
        Cells(2, colNo).Value = "ここに結果"
    Else
        MsgBox "列名が見つかりません: 単価", vbExclamation
    End If
End Sub
VB
  • ポイント:
    • 部分一致や大小文字区別の指定が1行で済む。
    • 未検出時は 0 を返すようにし、呼び出し側で分岐。

応用テンプレート

列名の配列で一括取得（存在しない列も丁寧に報告）

Sub GetMultipleColumnsByHeaders()
    Dim headers As Variant: headers = Array("商品名", "数量", "単価", "金額")
    Dim i As Long, miss As String

    For i = LBound(headers) To UBound(headers)
        Dim c As Long: c = GetColumnByHeader(headers(i), Range("A1:AZ1"))
        If c > 0 Then
            Cells(2, c).Value = "OK"
        Else
            miss = miss & headers(i) & vbCrLf
        End If
    Next

    If Len(miss) > 0 Then
        MsgBox "見つからない列名:" & vbCrLf & miss, vbExclamation
    End If
End Sub
VB

列名で参照して計算（列位置が変わっても壊れない）

Sub Calc_ByHeaderNames()
    Dim h As Range: Set h = Range("A1").CurrentRegion.Rows(1)
    Dim colQty As Long:  colQty = GetColumnByHeader("数量", h)
    Dim colPrice As Long: colPrice = GetColumnByHeader("単価", h)
    Dim colAmt As Long:   colAmt = GetColumnByHeader("金額", h)

    If colQty * colPrice * colAmt = 0 Then
        MsgBox "必要な列が見つかりません", vbExclamation
        Exit Sub
    End If

    Dim last As Long: last = Cells(Rows.Count, colQty).End(xlUp).Row
    Dim r As Long
    For r = 2 To last
        Cells(r, colAmt).Value = Val(Cells(r, colQty).Value) * Val(Cells(r, colPrice).Value)
    End If
End Sub
VB

よくある落とし穴と対策

  • 見出しに余分な空白/改行が含まれていて一致しない
    • 対策: 比較前に Trim や Replace(…, vbCrLf, "") で正規化。Dictionary化する時点で整えると楽。
  • 日本語の全角・半角や大文字小文字の揺れ
    • 対策: 事前に StrConv(…, vbNarrow/vbWide)、UCase/LCase で統一。Findなら MatchCase 指定、部分一致なら揺れに強い。
  • 部分一致が過剰にヒット（「金額」が「税込金額」にも当たる）
    • 対策: 基本は完全一致。やむを得ず部分一致なら、前後記号（例：「[」「]」「()」）や固定語尾を含めて絞る。
  • CurrentRegionの見出し行がずれている
    • 対策: 見出し行は明示範囲で指定（例：Range("A1:AZ1")）。テーブル（ListObject）を使って ListColumns("単価").Index も有効。
  • 大量の列名参照で遅い
    • 対策: 一度Dictionaryに列名→列番号をキャッシュして使い回す。Find/MATCHを都度呼ばない。

例題で練習

'例1：部分一致で「金額」を探し、該当列の値を値貼り付け
Sub Example_FindHeader_Partial_Values()
    Dim hit As Range, colNo As Long
    Set hit = Range("A1:AZ1").Find(What:="金額", LookAt:=xlPart, LookIn:=xlValues)
    If Not hit Is Nothing Then
        colNo = hit.Column
        With Range(Cells(2, colNo), Cells(10000, colNo))
            .Value = .Value
        End With
    End If
End Sub

'例2：列名から列番号を取り、A列から最終行まで「金額=数量×単価」を計算
Sub Example_CalcByNames()
    Dim h As Range: Set h = Range("A1:AZ1")
    Dim cQty As Long:  cQty = GetColumnByHeader("数量", h)
    Dim cPrice As Long: cPrice = GetColumnByHeader("単価", h)
    Dim cAmt As Long:   cAmt = GetColumnByHeader("金額", h)
    If cQty * cPrice * cAmt = 0 Then Exit Sub

    Dim last As Long: last = Cells(Rows.Count, cQty).End(xlUp).Row
    Range(Cells(2, cAmt), Cells(last, cAmt)).FormulaR1C1 = "=RC[" & (cQty - cAmt) & "]*RC[" & (cPrice - cAmt) & "]"
    Range(Cells(2, cAmt), Cells(last, cAmt)).Value = Range(Cells(2, cAmt), Cells(last, cAmt)).Value
End Sub

'例3：列名一覧をDictionary化して、必要列の有無をチェック
Sub Example_HeaderMap_Check()
    Dim h As Range: Set h = Range("A1").CurrentRegion.Rows(1)
    Dim map As Object: Set map = CreateObject("Scripting.Dictionary")
    Dim i As Long
    For i = 1 To h.Columns.Count
        map(Trim(CStr(h.Cells(1, i).Value))) = h.Cells(1, i).Column
    Next

    Dim need As Variant: need = Array("商品名", "数量", "単価", "金額")
    Dim miss As String
    For i = LBound(need) To UBound(need)
        If Not map.Exists(need(i)) Then miss = miss & need(i) & vbCrLf
    Next
    If Len(miss) > 0 Then MsgBox("不足列:" & vbCrLf & miss, vbExclamation)
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました