実践！Excelマクロ　～複数条件（OR条件）の検索方法

今回のエントリーは前回の複数条件（AND条件）の検索に引き続きOR条件で検索する場合のExcel　VBAマクロをトライしたいと思います。

Findメソッドを使ったOR条件はAND条件に比べて少々面倒です。
前回も書きましたがFindメソッドでは検索条件は一つしか指定出来ない為、条件の数だけFindメソッドの処理を繰り返す必要があります。

今回のサンプルでは検索条件を３つ設定していますので３回Findメソッドを繰り返します。

注意すべき点は、検索結果が重複する可能性がある為、２回目以降の検索で既に検索されていないかチェックする必要があります。

チェックをしない場合はこんな結果に

ちなみに、動作イメージやフォームデザインは前回のAND条件検索の記事をご参考下さい。

1.検索用コード

検索ボタンをクリックした際の動作を設定します。
VBAコードは以下の通りです。

'*****************************************************
'OR条件検索の処理
'*****************************************************
Private Sub cmdSerch_Click()
    Dim Obj As Object
    Dim wAddST As Variant
    Dim wAddress As Variant
    Dim wName As Variant
    Dim i As Integer
    Dim wlstCount As Integer
    
    With Worksheets("Sheet1")
 
        'リストボックスをクリア
        lstName.RowSource = ""
        lstName.Clear
        
        '***   テキストボックス「キーワード①」の値が含まれるセルを検索   ***
        
        'テキストボックス未入力の場合処理しない
        If txbName1.Value <> "" Then
           
           'キーワード１の値で検索
           Set Obj = .Cells.Find( _
                               What:=txbName1.Value, _
                               LookIn:=xlValues, _
                               lookat:=xlPart, _
                               MatchByte:=False)
    
           '検索対象が存在する場合
           If Not Obj Is Nothing Then
               '検索にヒットした先頭のセルのアドレスをセット
               wAddST = Obj.Address
       
               '検索の繰り返し処理
               Do
                   '検索にヒットしたセルのアドレスをセット
                   wAddress = Obj.Address
       
                   '検索にヒットしたセルの値を取得
                   wName = .Range(wAddress).Value
       
                   'リストボックスに追加
                   lstName.AddItem wName
       
                   '次の検索を行う
                   Set Obj = .Cells.FindNext(Obj)
       
                   '最初にヒットしたアドレスと同じ場合は処理を終了
                   If Obj.Address = wAddST Then Exit Do
               Loop
           End If
        End If
 
        
        '***   テキストボックス「キーワード②」の値が含まれるセルを検索   ***
        
        'テキストボックスの未入力または同じ値（含む）の場合処理しない
        If txbName2.Value <> "" And _
            InStr(txbName1.Value, txbName2.Value) = 0 Then
           
           'キーワード２の値で検索
           Set Obj = .Cells.Find( _
                               What:=txbName2.Value, _
                               LookIn:=xlValues, _
                               lookat:=xlPart, _
                               MatchByte:=False)
    
           '検索対象が存在する場合
            If Not Obj Is Nothing Then
               '検索にヒットした先頭のセルのアドレスをセット
               wAddST = Obj.Address
       
               '検索の繰り返し処理
               Do
                   '検索にヒットしたセルのアドレスをセット
                   wAddress = Obj.Address
       
                   '検索にヒットしたセルの値を取得
                   wName = .Range(wAddress).Value
                   
                   'リストボックスの値を読み込みます
                    wlstCount = 0
                    For i = 0 To Me.lstName.ListCount - 1
                       '既にリストボックスに追加されていないかチェック
                        If Me.lstName.List(i, 0) = wName Then
                            wlstCount = wlstCount + 1
                        End If
                    Next i

                   'リストボックスに重複が無い場合、値を追加
                   If wlstCount = 0 Then lstName.AddItem wName
              
                   '次の検索を行う
                   Set Obj = .Cells.FindNext(Obj)
       
                   '最初にヒットしたアドレスと同じ場合は処理を終了
                   If Obj.Address = wAddST Then Exit Do
               Loop
           End If
        End If

 
        '***   テキストボックス「キーワード③」の値が含まれるセルを検索   ***
        
        'テキストボックスの未入力または同じ値（含む）の場合処理しない
        If txbName3.Value <> "" And _
            InStr(txbName1.Value, txbName3.Value) = 0 And _
            InStr(txbName2.Value, txbName3.Value) = 0 Then
           
           'キーワード３の値で検索
           Set Obj = .Cells.Find( _
                               What:=txbName3.Value, _
                               LookIn:=xlValues, _
                               lookat:=xlPart, _
                               MatchByte:=False)
    
           '検索対象が存在する場合
            If Not Obj Is Nothing Then
               '検索にヒットした先頭のセルのアドレスをセット
               wAddST = Obj.Address
       
               '検索の繰り返し処理
               Do
                   '検索にヒットしたセルのアドレスをセット
                   wAddress = Obj.Address
       
                   '検索にヒットしたセルの値を取得
                   wName = .Range(wAddress).Value
       
                   'リストボックスの値を読み込みます
                    wlstCount = 0
                    For i = 0 To Me.lstName.ListCount - 1
                       '既にリストボックスに追加されていないかチェック
                        If Me.lstName.List(i, 0) = wName Then
                            wlstCount = wlstCount + 1
                        End If
                    Next i

                   'リストボックスに重複が無い場合、値を追加
                   If wlstCount = 0 Then lstName.AddItem wName
       
                   '次の検索を行う
                   Set Obj = .Cells.FindNext(Obj)
       
                   '最初にヒットしたアドレスと同じ場合は処理を終了
                   If Obj.Address = wAddST Then Exit Do
               Loop
           End If
        End If
         
    End With
 
End Sub

2.コードの解説

基本はFindメソッドで説明したコードを条件分だけ３回繰り返している、ひねりの無いコードですが、２回目以降の検索でリストボックスに格納した値と検索結果の値をチェックしています。（82～92行目）

'リストボックスの値を読み込みます
 wlstCount = 0
 For i = 0 To Me.lstName.ListCount - 1
    '既にリストボックスに追加されていないかチェック
     If Me.lstName.List(i, 0) = wName Then
         wlstCount = wlstCount + 1
     End If
 Next i

'リストボックスに重複が無い場合、値を追加
If wlstCount = 0 Then lstName.AddItem wName