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

  このエントリーをはてなブックマークに追加  

複数の単語を一括検索

シート内のデータから、複数の単語を一括で検索し選択するマクロです。



検索に一致したセルをまとめて選択するので、セルやフォントに色を付けるといったことも可能です。

コードの貼り付け場所

サンプルコード

Sub Sample_FIND_1() '検索対象:アクティブシート
    Dim varArray As Variant, v As Variant
    Dim strAddress As String
    Dim rngFnd As Range, rngUni As Range
    
    varArray = Array("りんご", "リンゴ") '検索文字列
    
    For Each v In varArray
        Set rngFnd = Cells.Find(What:=v, LookAt:=xlPart) '検索 1周目「りんご」2周目「リンゴ」
        If Not rngFnd Is Nothing Then   '
            strAddress = rngFnd.Address '最初に検索一致したセルの番地格納
            If rngUni Is Nothing Then Set rngUni = rngFnd
            Do
                Set rngUni = Union(rngUni, rngFnd)  'セルを集合
                Set rngFnd = Cells.FindNext(rngFnd) '次の一致セルを検索
            Loop Until strAddress = rngFnd.Address  'セルのアドレスが一致したらループを抜ける
        End If
    Next
    
    If Not rngUni Is Nothing Then rngUni.Select '検索一致セルの選択
End Sub

「検索文字列」
 検索する文字列です。検索文字列の追加は、次の例を参考にしてください。
 例:Array("りんご", "リンゴ") → Array("りんご", "リンゴ", "みかん", "ぶどう")

「LookAt:=xlPart
 検索文字列が、セル内のデータに含まれる場合も一致判定となります。
 【例】検索文字列:りんご セル内データ:青りんご → 一致判定
 セルと完全一致のみを一致とする場合:xlPart → xlWhole

「rngUni.Select」
 コード最後の「rngUni.Select」を「rngUni.EntireRow.Select」に変更すると、
 検索一致セルを含む行を選択します。

アクティブブックの全てのワークシートを対象に、検索する場合は、次のコードを参照ください。

Sub Sample_FIND_2() '検索対象:アクティブブックの全ワークシート
    Dim Sh As Worksheet
    Dim varArray As Variant, v As Variant
    Dim strAddress As String
    Dim rngFnd As Range, rngUni As Range
    
    varArray = Array("りんご", "リンゴ") '検索文字列
    
    For Each Sh In ActiveWorkbook.Worksheets
        Sh.Select
        For Each v In varArray
            Set rngFnd = Sh.Cells.Find(What:=v, LookAt:=xlPart) '検索
            If Not rngFnd Is Nothing Then
                strAddress = rngFnd.Address '最初に検索一致したセルの番地格納
                If rngUni Is Nothing Then Set rngUni = rngFnd
                Do
                    Set rngUni = Union(rngUni, rngFnd)  'セルを集合
                    Set rngFnd = Sh.Cells.FindNext(rngFnd) '次を検索
                Loop Until strAddress = rngFnd.Address
            End If
        Next
        If Not rngUni Is Nothing Then rngUni.Select '検索一致セルの選択
        Set rngUni = Nothing
    Next
End Sub
ページトップへ戻る

Excel 汎用コード

Word 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.