VBAで複数のキーワードを一括検索！Findメソッドを使いこなす方法

Excel VBAを使って、複数のキーワードを一気に検索したいという場面はよくあります。
例えば、「重要」「要確認」「至急」など、複数の注意すべき言葉が含まれていないかをシート内で探したい時などです。

しかし、VBAのFindメソッドは基本的に一度に一つの語しか検索できません。
では、複数の検索語を扱いたい場合はどうすればいいのでしょうか？
本記事では、VBAにおけるFindの基本的な使い方から、複数キーワードを扱うための実践的なテクニックまで、サンプルコードと共に詳しく解説します。
実務で役立つスクリプトを目指して、ぜひ最後までご覧ください。

VBAのFindメソッドの基本構文とは？
複数のキーワードを検索するにはループ処理が基本
ヒットしたセルに色を付けるコード例
大文字・小文字の区別や全角・半角の扱い
複数キーワードの検索結果をリスト化する方法
まとめ

VBAのFindメソッドの基本構文とは？

まずは、VBAでのFindメソッドの基本的な使い方をおさらいしておきましょう。

Dim rng As Range
Set rng = Worksheets("Sheet1").Range("A1:A100").Find(What:="キーワード", LookIn:=xlValues, LookAt:=xlPart)

If Not rng Is Nothing Then
    MsgBox "見つかりました！" & rng.Address
End If

このコードでは、シート「Sheet1」のA1からA100の範囲内で「キーワード」を検索しています。
LookInやLookAtの設定によって、検索対象や一致の仕方を指定することができます。

複数のキーワードを検索するにはループ処理が基本

VBAでは、Findメソッドで一度に複数の語を検索することはできません。
そのため、複数のキーワードを一つずつ順番に検索していくループ処理を用います。

以下は、複数キーワードを一括で検索して、ヒットしたセルのアドレスをメッセージボックスに表示するサンプルです。

Sub FindMultipleWords()
    Dim keywords As Variant
    Dim ws As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range
    Dim firstAddress As String
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set searchRange = ws.Range("A1:A100")

    ' 検索キーワードの配列
    keywords = Array("重要", "至急", "確認")

    For i = LBound(keywords) To UBound(keywords)
        Set foundCell = searchRange.Find(What:=keywords(i), LookIn:=xlValues, LookAt:=xlPart)
        
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                MsgBox "キーワード「" & keywords(i) & "」が見つかりました：" & foundCell.Address
                Set foundCell = searchRange.FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
        End If
    Next i
End Sub

このコードでは、Arrayで指定した複数のキーワードを一つずつ順に検索し、すべての一致箇所に対してメッセージを表示しています。

ヒットしたセルに色を付けるコード例

実務では、検索結果を視覚的に把握できるようにセルに色を付けたいというニーズもあるでしょう。
以下は、ヒットしたセルに色を塗るコードの例です。

Sub HighlightKeywords()
    Dim keywords As Variant
    Dim ws As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range
    Dim firstAddress As String
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set searchRange = ws.UsedRange

    keywords = Array("重要", "至急", "確認")

    For i = LBound(keywords) To UBound(keywords)
        Set foundCell = searchRange.Find(What:=keywords(i), LookIn:=xlValues, LookAt:=xlPart)
        
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                foundCell.Interior.Color = RGB(255, 255, 0) ' 黄色で塗りつぶし
                Set foundCell = searchRange.FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
        End If
    Next i
End Sub

UsedRangeを対象にすることで、データのある範囲を一括検索できます。
また、RGB(255, 255, 0)で黄色に塗りつぶすようにしていますが、色は自由に変更可能です。

大文字・小文字の区別や全角・半角の扱い

Findメソッドには、検索に関していくつかのオプションがあります。
その中でも特に注意したいのが、大文字・小文字や全角・半角の扱いです。

大文字小文字を区別する例：

Set foundCell = searchRange.Find(What:=keywords(i), MatchCase:=True)

このように、MatchCase:=Trueを指定することで、大文字と小文字を区別した検索になります。

全角・半角の違い：

Findメソッドでは、基本的に全角と半角は別の文字として扱われます。
そのため、「ｱｲｳ」と「アイウ」は別物とされ、注意が必要です。
必要に応じて、事前にデータをStrConv関数で統一するのも手です。

複数キーワードの検索結果をリスト化する方法

検索した結果をシート上に一覧化したい場合もあります。
以下は、検索結果を別シートに一覧出力するコード例です。

Sub OutputFoundList()
    Dim keywords As Variant
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range
    Dim firstAddress As String
    Dim i As Long, rowCounter As Long

    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set searchRange = wsSource.UsedRange

    ' 結果出力用のシートを作成
    Set wsResult = ThisWorkbook.Sheets.Add
    wsResult.Name = "検索結果"
    wsResult.Range("A1:C1").Value = Array("キーワード", "セルアドレス", "内容")
    rowCounter = 2

    keywords = Array("重要", "至急", "確認")

    For i = LBound(keywords) To UBound(keywords)
        Set foundCell = searchRange.Find(What:=keywords(i), LookIn:=xlValues, LookAt:=xlPart)
        
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                wsResult.Cells(rowCounter, 1).Value = keywords(i)
                wsResult.Cells(rowCounter, 2).Value = foundCell.Address
                wsResult.Cells(rowCounter, 3).Value = foundCell.Value
                rowCounter = rowCounter + 1

                Set foundCell = searchRange.FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
        End If
    Next i
End Sub