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

Excel VBA
スポンサーリンク

行名で検索

「見出しが縦に並ぶ“行名”から、該当行を素早く見つけたい」。業務で頻出のニーズを、初心者でも使えるテンプレでまとめます。Find、MATCH、Dictionary化、自作関数まで、使い分けと落とし穴対策もセットです。

方針の選び方

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

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

Sub FindRowName_Basic()
    Dim nameCol As Range, hit As Range, rowNo As Long
    Set nameCol = Range("A1:A1000") '行名が並ぶ列（縦）
    Set hit = nameCol.Find(What:="売上合計", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    If Not hit Is Nothing Then
        rowNo = hit.Row
        Cells(rowNo, "D").Value = "ここに結果" '見つかった行の任意列へアクセス
    Else
        MsgBox "行名が見つかりません: 売上合計", vbExclamation
    End If
End Sub
VB
  • ポイント
    • 完全一致は xlWhole、部分一致は xlPart。
    • 値検索（xlValues）が基本。数式テキストなら xlFormulas。
    • hit.Row はワークシートの実行番号。

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

Sub MatchRowName_ToRow()
    Dim pos As Variant, nameCol As Range, startRow As Long, rowNo As Long
    Set nameCol = Range("A1:A1000")          '行名の縦範囲
    startRow = nameCol.Row                    '範囲の開始行番号

    On Error Resume Next
    pos = Application.WorksheetFunction.Match("売上合計", nameCol, 0) '0=完全一致
    On Error GoTo 0

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

実務定番：行名→行番号をDictionaryにキャッシュ

Sub BuildRowMap_AndUse()
    Dim nameCol As Range: Set nameCol = Range("A1:A1000") '行名列
    Dim map As Object: Set map = CreateObject("Scripting.Dictionary")
    Dim r As Long, last As Long

    last = nameCol.Cells(nameCol.Rows.Count, 1).End(xlUp).Row
    For r = nameCol.Row To last
        If Len(Trim$(CStr(Cells(r, 1).Value))) > 0 Then
            map(Trim$(CStr(Cells(r, 1).Value))) = r  'キー=行名、値=行番号
        End If
    Next

    If map.Exists("売上合計") Then
        Cells(map("売上合計"), "D").Value = "ここに結果"
    Else
        MsgBox "行名が見つかりません: 売上合計", vbExclamation
    End If
End Sub
VB
  • ポイント
    • 複数参照を爆速に。 一度作った辞書を使い回せる。
    • 揺れ対策: キー登録時は Trim + CStr で正規化が安全。

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

Function GetRowByName(ByVal rowName As String, ByVal nameRange 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 = nameRange.Find(What:=rowName, LookAt:=lookAt, LookIn:=xlValues, MatchCase:=matchCase)
    If Not hit Is Nothing Then
        GetRowByName = hit.Row
    Else
        GetRowByName = 0 '未検出のシグナル
    End If
End Function

'使い方例
Sub Use_GetRowByName()
    Dim r As Long
    r = GetRowByName("売上合計", Range("A1:A2000"))
    If r > 0 Then
        Cells(r, "D").Value = "ここに結果"
    Else
        MsgBox "行名が見つかりません: 売上合計", vbExclamation
    End If
End Sub
VB
  • ポイント
    • 部分一致や大小文字区別を引数で指定可能。
    • 0を返す設計にして、呼び出し側で分岐しやすく。

応用テンプレート

複数行名を一括取得（不足を丁寧に報告）

Sub GetMultipleRowsByNames()
    Dim names As Variant: names = Array("売上合計", "原価合計", "粗利")
    Dim i As Long, miss As String, r As Long

    For i = LBound(names) To UBound(names)
        r = GetRowByName(names(i), Range("A1:A3000"))
        If r > 0 Then
            Cells(r, "E").Value = "OK"
        Else
            miss = miss & names(i) & vbCrLf
        End If
    Next

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

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

Sub Calc_ByRowNames()
    Dim rSales As Long: rSales = GetRowByName("売上合計", Range("A1:A3000"))
    Dim rCost As Long:  rCost  = GetRowByName("原価合計", Range("A1:A3000"))
    Dim rGross As Long: rGross = GetRowByName("粗利",     Range("A1:A3000"))
    If rSales * rCost * rGross = 0 Then
        MsgBox "必要な行名が見つかりません", vbExclamation
        Exit Sub
    End If

    Cells(rGross, "D").Value = Val(Cells(rSales, "D").Value) - Val(Cells(rCost, "D").Value)
End Sub
VB

行名の一覧をDictionary化して、必要行の有無をチェック

Sub RowMap_Check()
    Dim map As Object: Set map = CreateObject("Scripting.Dictionary")
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Dim r As Long
    For r = 1 To last
        map(Trim$(CStr(Cells(r, "A").Value))) = r
    Next

    Dim need As Variant: need = Array("売上合計", "原価合計", "粗利")
    Dim miss As String, i As Long
    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

よくある落とし穴と対策

  • 余分な空白や改行で一致しない
    • 対策: 比較前に Trim、Replace(…, vbCrLf, “”) で正規化。辞書化時に整えると楽。
  • 日本語の全角・半角・大小文字の揺れ
    • 対策: StrConv(…, vbNarrow/vbWide) や UCase/LCase で統一。Findなら MatchCase 指定、部分一致なら揺れに強い。
  • 部分一致が過剰ヒット（「売上」が「売上合計」にも当たる）
    • 対策: 基本は完全一致。部分一致を使うなら前後の区切りや語尾を含めて絞る。
  • 列挙中のFind設定が引き継がれて意図外検索
    • 対策: Findの引数（LookAt/LookIn/MatchCase/SearchOrder）を毎回明示。Find→FindNextは1ループで完結。
  • 大量の行名参照で遅い
    • 対策: 一度Dictionaryにキャッシュして使い回す。都度Find/MATCHは避ける。

例題で練習

'例1：部分一致で「粗利」を探し、該当行の値を値貼り付け
Sub Example_FindRow_Partial_Values()
    Dim hit As Range, rowNo As Long
    Set hit = Range("A1:A3000").Find(What:="粗利", LookAt:=xlPart, LookIn:=xlValues)
    If Not hit Is Nothing Then
        rowNo = hit.Row
        With Range(Cells(rowNo, "D"), Cells(rowNo, "Z"))
            .Value = .Value
        End With
    End If
End Sub

'例2：行名から行番号を取り、売上合計・原価合計・粗利を計算
Sub Example_CalcByRowNames()
    Dim rSales As Long: rSales = GetRowByName("売上合計", Range("A1:A3000"))
    Dim rCost  As Long: rCost  = GetRowByName("原価合計", Range("A1:A3000"))
    Dim rGross As Long: rGross = GetRowByName("粗利",     Range("A1:A3000"))
    If rSales * rCost * rGross = 0 Then Exit Sub
    Cells(rGross, "D").Value = Val(Cells(rSales, "D").Value) - Val(Cells(rCost, "D").Value)
End Sub

'例3：行名一覧をDictionary化して、必要行の有無をチェック
Sub Example_RowMap_Check()
    Dim map As Object: Set map = CreateObject("Scripting.Dictionary")
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Dim r As Long
    For r = 1 To last
        map(Trim$(CStr(Cells(r, "A").Value))) = r
    Next
    Dim need As Variant: need = Array("売上合計", "原価合計", "粗利")
    Dim miss As String, i As Long
    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をコピーしました