Excel VBA 逆引き集 | 部分一致検索

Excel VBA
スポンサーリンク

部分一致検索

「含まれていればヒット」で探したいときの定番は Range.Find（xlPart）と InStr。複数ヒットの列挙、色付け・抽出、ワイルドカードや正規表現まで、初心者でも迷わないテンプレをまとめます。

方針の選び方

  • 最短・高速でセル検索: Range.Find + xlPart（FindNextで全件）
  • 柔軟にカスタム判定: InStr（大小文字の扱いや複合条件が書きやすい）
  • ワイルドカードでパターン検索: Like演算子（? * # など）
  • 高度なパターン: 正規表現（RegExp）
  • 絞り込み表示だけでOK: AutoFilter（抽出後にコピー）

基本：Range.Find（部分一致）で1件ヒット

Sub PartialFind_One()
    Dim src As Range, hit As Range
    Set src = Range("A2:A10000")
    Set hit = src.Find(What:="ERROR", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If Not hit Is Nothing Then
        MsgBox "ヒット: " & hit.Address & " 値=" & hit.Value
    Else
        MsgBox "見つかりません"
    End If
End Sub
VB
  • ポイント:
    • LookAt: 部分一致は xlPart。完全一致は xlWhole。
    • LookIn: 値なら xlValues、数式文字列なら xlFormulas。
    • MatchCase: 大文字小文字を区別するなら True。

定番：Find → FindNext で全件列挙（安全テンプレ）

Sub PartialFind_All()
    Dim src As Range, hit As Range, first As String
    Set src = Range("A2:A50000")

    Set hit = src.Find(What:="WARN", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If hit Is Nothing Then Exit Sub

    first = hit.Address
    Do
        Debug.Print "ヒット: "; hit.Address; " 値="; hit.Value
        Set hit = src.FindNext(hit)
    Loop While Not hit Is Nothing And hit.Address <> first
End Sub
VB
  • ポイント:
    • firstを記録: 最初のヒットに戻ったら終了するのが無限ループ対策。
    • 毎回引数を明示: Findは設定を保持するため、意図を固定する。

応用1：ヒット行を抽出シートへコピー＋色付け

Sub PartialFind_CopyAndHighlight()
    Dim src As Range, hit As Range, first As String
    Dim out As Worksheet, outRow As Long
    Set src = Range("A2:A60000")
    Set out = Worksheets("抽出"): outRow = 2

    Set hit = src.Find(What:="ERROR", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If hit Is Nothing Then Exit Sub

    first = hit.Address
    Do
        hit.EntireRow.Copy Destination:=out.Rows(outRow)
        hit.Interior.Color = RGB(255, 235, 156)
        outRow = outRow + 1
        Set hit = src.FindNext(hit)
    Loop While Not hit Is Nothing And hit.Address <> first
End Sub
VB
  • ポイント:
    • EntireRow.Copy: 行ごと抽出が簡単。
    • 書式適用は最小回数: 必要箇所だけに色を付ける。

応用2：複数キーワード（OR条件）で全件検索

Sub PartialFind_MultiKeywords()
    Dim kw As Variant: kw = Array("ERROR", "WARN", "CRITICAL")
    Dim src As Range, hit As Range, first As String
    Dim i As Long
    Set src = Range("A2:A80000")

    For i = LBound(kw) To UBound(kw)
        Set hit = src.Find(What:=kw(i), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        If Not hit Is Nothing Then
            first = hit.Address
            Do
                hit.Font.Color = vbRed
                Set hit = src.FindNext(hit)
            Loop While Not hit Is Nothing And hit.Address <> first
        End If
    Next i
End Sub
VB
  • ポイント:
    • キーワード単位で1周完結: Findの状態混線を防げる。
    • 重複ヒットの扱い: 同じセルが複数キーワードに該当する可能性あり。必要なら一度Unionで集合化して一括処理。

InStrで柔軟に判定（大小文字・複合条件）

Sub Partial_InStr_Filter()
    Dim last As Long, r As Long, s As String
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If InStr(1, s, "error", vbTextCompare) > 0 Or InStr(1, s, "warn", vbTextCompare) > 0 Then
            Cells(r, "A").Font.Bold = True
        End If
    Next
End Sub
VB
  • ポイント:
    • vbTextCompare: 大小文字を無視した比較。
    • 複合条件が書きやすい: AND/ORや前後検査、数値条件も同じループで扱える。

Like演算子でワイルドカード検索

Sub Partial_Like_Wildcard()
    Dim last As Long, r As Long, s As String
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If s Like "*ERR*2025*" Then         '「ERR」と「2025」を含む
            Cells(r, "A").Interior.Color = RGB(255, 200, 200)
        End If
    Next
End Sub
VB
  • ポイント:
    • 主な記号: *=任意長、?=任意1文字、#=数字1文字。
    • 日本語でもOK: 文字列全体のパターンに強い。

正規表現（電話番号・コード形式などを精密に）

Sub Partial_RegExp()
    Dim re As Object, m As Object
    Dim last As Long, r As Long, s As String
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "\b[A-Z]{3}-\d{4}\b"   '例：ABC-1234
    re.Global = False: re.IgnoreCase = False

    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If re.Test(s) Then
            Cells(r, "A").Interior.Color = RGB(200, 255, 200)
        End If
    Next
End Sub
VB
  • ポイント:
    • 複雑パターンに最適: 書式のバリデーションや抽出に強い。
    • IgnoreCase: 大小文字の扱いを制御可能。

表だけ絞れれば良い：AutoFilterで部分一致抽出

Sub Partial_AutoFilter()
    With Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:="*ERROR*", Operator:=xlOr, Criteria2:="*WARN*"
        '抽出された行を丸ごと別シートへコピーなど
        .SpecialCells(xlCellTypeVisible).Copy Worksheets("抽出").Range("A1")
        .AutoFilter '解除
    End With
End Sub
VB
  • ポイント:
    • Criteriaにワイルドカード: 「含む」条件が簡単。
    • 表示ベースで抽出: コード量少なく実用的。

安全・高速ラップ（大量処理に効く）

Sub Partial_SafeWrap_Start()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub

Sub Partial_SafeWrap_End()
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 前後で停止→復帰: これだけで体感速度が変わる。
    • 失敗時も復帰: On Error で後始末を保証するとさらに安全。

よくある落とし穴と対策

  • 設定保持で意図外検索になる
    • 対策: Findの引数（LookAt/LookIn/MatchCase/SearchOrder）を毎回明示。
  • FindNextの無限ループ
    • 対策: 最初のヒットのAddressを記録し、同じAddressに戻ったら終了。
  • 全角・半角・大小文字の差で漏れる
    • 対策: 比較前に UCase/LCase や StrConv(s, vbNarrow/vbWide) で正規化。FindはMatchCase、InStrは比較モードで調整。
  • 日本語混在でワイルドカードが過剰ヒット
    • 対策: より厳密なら正規表現へ切り替え。前後の区切り（空白・記号）をパターンに含める。
  • 大量データで遅い
    • 対策: まとめて抽出ならAutoFilter、セル書式変更はUnionで集合化して一括処理。画面更新・再計算を止める。

例題で練習

'例1：A列の「ERROR」を全部赤字
Sub Example_AllErrorRed()
    Dim rng As Range, hit As Range, first As String
    Set rng = Range("A2:A30000")
    Set hit = rng.Find("ERROR", LookIn:=xlValues, LookAt:=xlPart)
    If hit Is Nothing Then Exit Sub
    first = hit.Address
    Do
        hit.Font.Color = vbRed
        Set hit = rng.FindNext(hit)
    Loop While Not hit Is Nothing And hit.Address <> first
End Sub

'例2：Likeで「*NG*2025*」にマッチする行だけ抽出シートへ
Sub Example_LikeExtract()
    Dim last As Long, r As Long, s As String, outRow As Long
    last = Cells(Rows.Count, "A").End(xlUp).Row: outRow = 2
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If s Like "*NG*2025*" Then
            Rows(r).Copy Destination:=Worksheets("抽出").Rows(outRow)
            outRow = outRow + 1
        End If
    Next
End Sub

'例3：RegExpで「AAA-9999」形式だけ緑背景
Sub Example_RegExpFormat()
    Dim re As Object, last As Long, r As Long, s As String
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "^[A-Z]{3}-\d{4}$": re.IgnoreCase = False
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        s = CStr(Cells(r, "A").Value)
        If re.Test(s) Then Cells(r, "A").Interior.Color = RGB(200, 255, 200)
    Next
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました