複数のキーワードを含むセルを検索する

Excelの検索機能では
Googleで検索するときのように
複数のキーワードを空白で区切って入力して
検索することはできません。

VBAで
複数のキーワードをすべて含むセルを
検索できるコードを作っていきます。

以下コードの流れを説明します。

複数のキーワードの文字列はInputBoxを使って取得して
変数kys_strに格納します。

取得した文字列の前後に余分なスペースがある場合の対策として
LTrim関数，RTrim関数で前後のスペースを削除します。

また，スペースが半角か全角か不明のため
すべてを半角に統一します。
そのために全角のスペースのみ
半角のスペースにReplace関数で置換します。

ここまでの処理で文字列の前後のスペースがなく
スペースがあれば半角スペースの文字列に修正されました。

InputBoxに何も入力されなかった場合
kys_str = ""となるので
これで判断してマクロを終了します。

次に，
半角スペースの1文字前を区切りにしたいため
文字列の最後に半角のスペースを追加します。

Do　Loop文の中のコードで
取得した文字列を1つのキーワードごとに
1次元配列に格納します。

同時に
キーワードを検索したときに
検索結果を入れる配列flag_aryも
キーワードの数だけ空で作成します。

For Each文の中で
アクティブシートの使用している範囲のセルに対して
各キーワードに一致する部分があるかを
If文で判定していきます。

一致すれば 各キーワードに対応するflag_ary(i) = Trueにして，
一致しなければflag_ary(i) = Falseにします。

flag_ary(i)がすべてTureの場合のみ
flag = Trueにします。
1つでもFlaseがあればflag = Falseになります。

flag = Trueで
すべてのキーワードが含まれるという判断になります。

flag = Trueになるセルを見つけたら
そのセルを選択して，
セル位置をMsgBoxに表示させます。
MsgBoxでセルの色を付けるかOK/キャンセルで決定します。

色付けしたセルはオートフィルタの抽出条件に使えます。

Sub Macro20200427a()
'複数キーワードで検索

    Dim kys_str As String
    Dim kys_ary() As String
    Dim i As Integer, j As Integer
    Dim flag_ary() As Boolean
    Dim flag As Boolean
    Dim color_flag As Integer
    Dim c As Range
    Dim f
   
    '文字列取得
    kys_str = InputBox("検索するワードを空白で区切って入力して下さい。")
   
    '文字列の前処理
    '文字列の前後のスペースを削除
    kys_str = LTrim(kys_str)
    kys_str = RTrim(kys_str)
   
    '全角のスペースを半角に修正
    kys_str = Replace(kys_str, "　", " ")
   
    '入力内容がない場合，終了
    If kys_str = "" Then
        MsgBox "入力内容がありません。終了します。"
        Exit Sub
    End If
   
    '文字列の最後にスペースを追加
    kys_str = kys_str & " "
   
    'キーワードを1次元配列kys_aryに格納する
    i = 0
    Do While InStr(kys_str, " ") <> 0
        ReDim Preserve kys_ary(i)
        ReDim Preserve flag_ary(i)
        kys_ary(i) = Left(kys_str, InStr(kys_str, " ") - 1)
        i = i + 1
        kys_str = Mid(kys_str, InStr(kys_str, " ") + 1, Len(kys_str))
        kys_str = LTrim(kys_str)
    Loop
      
    '複数キーワードで検索
    For Each c In ActiveSheet.UsedRange
        '各キーワードが含まれるか確認
        For j = 0 To UBound(kys_ary())
            If InStr(c, kys_ary(j)) = 0 Then
                flag_ary(j) = False
            Else
                flag_ary(j) = True
            End If
        Next j
       
        '各キーワードのフラグを確認
        'すべてTrueならflag=Ture
        '1つでもFalseがあればflag=False
        flag = True
        For Each f In flag_ary()
            If f = False Then
                flag = False
                Exit For
            End If
        Next f
       
        If flag = True Then
            c.Select
           
            color_flag = MsgBox("条件に一致：行" & _
                c.Row & ", 列" & c.Column & Chr(10) & _
                "色付けしますか？", _
                vbOKCancel + vbInformation)
               
            'セルを色付け
            If color_flag = 1 Then
                c.Interior.Color = RGB(200, 255, 255)
            End If
        End If
       
    Next c
   
    MsgBox "検索終了しました。"

End Sub

実行例を示します。

次の画像の状態のシートで実行します。

表示されるInputBoxに次の画像のように入力します。

すべてのキーワードを含むセルがあると
メッセージボックスが表示されます。

[はい]をクリックするとセルに塗りつぶしの色が付けられます。

使用Ver：Excel For Office365