トップ　>　汎用コード　>　複数の単語を一括検索

'--------------------------------------------------
' アクティブシートから任意の文字列を検索し選択する
'--------------------------------------------------
Sub sampleFind1()
    Dim varArray   As Variant
    Dim varWhat    As Variant
    Dim rngFind    As Range
    Dim rngUnion   As Range
    Dim strAddress As String
    
    '----------------------------------------
    ' 検索文字列
    '----------------------------------------
    varArray = Array("りんご", "リンゴ")
    
    For Each varWhat In varArray '検索値：1周目「りんご」2周目「リンゴ」
        '----------------------------------------------------------------------------------------------
        ' Range.Findメソッド
        '----------------------------------------------------------------------------------------------
        '［引数］
        '   What           ：検索する文字列
        '   After          ：検索を開始するセルを指定（省略すると検索対象セル範囲の最左上セルから検索開始）
        '   LookIn         ：情報種類　値：xlValues　数式：xlFormulas　コメント文：xlComments
        '   LookAt         ：一致の種類    部分一致：xlPart　全体一致：xlWhole
        '   SearchOrder    ：検索方法   1行ごと検索：xlByRows　1列ごと検索：xlByColumns
        '   SearchDirection：検索順  一致する次の値：xlNext　一致する前の値：xlPrevious
        '   MatchCase      ：大文字・小文字の区別  区別する：True　区別しない：False
        '   MatchByte      ：全角・半角の区別      区別する：True　区別しない：False
        '   SearchFormat   ：書式での検索　書式で検索する：True　書式で検索しない：False
        '----------------------------------------------------------------------------------------------
        Set rngFind = Cells.Find(What:=varWhat, _
                                 LookIn:=xlValues, _
                                 LookAt:=xlPart, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlNext, _
                                 MatchCase:=False, _
                                 MatchByte:=False)
        If Not rngFind Is Nothing Then
            strAddress = rngFind.Address                '最初に検索一致したセルのアドレスを取得
            If rngUnion Is Nothing Then Set rngUnion = rngFind
            Do
                Set rngUnion = Union(rngUnion, rngFind) 'セルを集合
                Set rngFind = Cells.FindNext(rngFind)   '次の一致セルを検索
            Loop Until strAddress = rngFind.Address     'セルアドレスが最初のセルと同じ場合はループを抜ける
        End If
    Next
    
    '----------------------------------------
    ' 検索一致セルを選択
    '----------------------------------------
    If Not rngUnion Is Nothing Then rngUnion.Select
End Sub

'----------------------------------------------------------------
' アクティブブックの全てのシートから任意の文字列を検索し選択する
'----------------------------------------------------------------
Sub sampleFind2()
    Dim varArray   As Variant
    Dim varWhat    As Variant
    Dim rngFind    As Range
    Dim rngUnion   As Range
    Dim Sh         As Worksheet
    Dim strAddress As String
    
    '----------------------------------------
    ' 検索文字列
    '----------------------------------------
    varArray = Array("りんご", "リンゴ")
    
    For Each Sh In ActiveWorkbook.Worksheets
        Sh.Select
        For Each varWhat In varArray '検索値：1周目「りんご」2周目「リンゴ」
            '----------------------------------------------------------------------------------------------
            ' Range.Findメソッド
            '----------------------------------------------------------------------------------------------
            '［引数］
            '   What           ：検索する文字列
            '   After          ：検索を開始するセルを指定（省略すると検索対象セル範囲の最左上セルから検索開始）
            '   LookIn         ：情報種類　値：xlValues　数式：xlFormulas　コメント文：xlComments
            '   LookAt         ：一致の種類    部分一致：xlPart　全体一致：xlWhole
            '   SearchOrder    ：検索方法   1行ごと検索：xlByRows　1列ごと検索：xlByColumns
            '   SearchDirection：検索順  一致する次の値：xlNext　一致する前の値：xlPrevious
            '   MatchCase      ：大文字・小文字の区別  区別する：True　区別しない：False
            '   MatchByte      ：全角・半角の区別      区別する：True　区別しない：False
            '   SearchFormat   ：書式での検索　書式で検索する：True　書式で検索しない：False
            '----------------------------------------------------------------------------------------------
            Set rngFind = Cells.Find(What:=varWhat, _
                                     LookIn:=xlValues, _
                                     LookAt:=xlPart, _
                                     SearchOrder:=xlByRows, _
                                     SearchDirection:=xlNext, _
                                     MatchCase:=False, _
                                     MatchByte:=False)
            If Not rngFind Is Nothing Then
                strAddress = rngFind.Address
                If rngUnion Is Nothing Then Set rngUnion = rngFind
                Do
                    Set rngUnion = Union(rngUnion, rngFind)
                    Set rngFind = Cells.FindNext(rngFind)
                    If rngFind Is Nothing Then Exit Do
                Loop Until strAddress = rngFind.Address
            End If
        Next
        '----------------------------------------
        ' 検索一致セルの選択
        '----------------------------------------
        If Not rngUnion Is Nothing Then rngUnion.Select
        Set rngUnion = Nothing
    Next
    
End Sub