実践！Excelマクロ ～複数条件（OR条件）の検索方法
今回のエントリーは前回の複数条件（AND条件）の検索に引き続きOR条件で検索する場合のExcel VBAマクロをトライしたいと思います。
Findメソッドを使ったOR条件はAND条件に比べて少々面倒です。
前回も書きましたがFindメソッドでは検索条件は一つしか指定出来ない為、条件の数だけFindメソッドの処理を繰り返す必要があります。
今回のサンプルでは検索条件を３つ設定していますので３回Findメソッドを繰り返します。
注意すべき点は、検索結果が重複する可能性がある為、２回目以降の検索で既に検索されていないかチェックする必要があります。
チェックをしない場合はこんな結果に
ちなみに、動作イメージやフォームデザインは前回のAND条件検索の記事をご参考下さい。
1.検索用コード
検索ボタンをクリックした際の動作を設定します。
VBAコードは以下の通りです。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | '*****************************************************'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行目）
1 2 3 4 5 6 7 8 9 10 11 | 'リストボックスの値を読み込みます 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 |
検索関連エントリー
以上、今回は複数条件（OR条件）で検索する為のVBAコードでした。
今回のサンプルファイルは以下のリンクからダウンロード可能です。
