複数の単語を一括検索2021.04.02 更新:2024.01.04
シート内のデータから、複数の単語を一括で検索し選択するマクロです。
検索結果を一覧にしたい場合はこちら
検索に一致したセルを選択するので、対象のセルにまとめて色を付けたり、フォント色を設定するといったことも可能です。
【お薦め】マクロ・プロシージャを管理する無料のツール!
Excelマクロ管理ツール
Excelマクロ管理ツール
サンプルコード2021.04.02 更新:2024.01.04
'-------------------------------------------------- ' アクティブシートから任意の文字列を検索し選択する '-------------------------------------------------- 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
「検索文字列」
検索する文字列です。検索文字列の追加は、次の例を参考にしてください。
例:Array("りんご", "リンゴ") → Array("りんご", "リンゴ", "みかん", "ぶどう")
「LookAt:=xlPart」
検索文字列が、セル内のデータに含まれる場合も一致判定となります。
【例】検索文字列:りんご セル内データ:青りんご → 一致判定
セルと完全一致のみを一致とする場合:xlPart → xlWhole
「rngUnion.Select」
コード最後の「rngUnion.Select」を「rngUnion.EntireRow.Select」に変更すると、
検索一致セルを含む行を選択します。
アクティブブックの全てのワークシートを対象に、検索する場合は、次のコードを参照ください。
'---------------------------------------------------------------- ' アクティブブックの全てのシートから任意の文字列を検索し選択する '---------------------------------------------------------------- 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