Excelの表を複数条件で検索出来る機能をVBAで作成する（ADO）
今回のエントリーはADOを使ってSQLでExcelのシートを検索する方法をアップします。
ExcelでADOを使った関連エントリーは「ADOを使ってExcelをテーブルとして読み込む方法について」もご参考下さい。
今回のサンプルは以下の様な画面構成で複数の条件で検索を実行します。
■検索用シート「検索指示」
■検索対象のシート「商品マスター」
■検索結果のシート「検索結果」
カテゴリーが「ぶどう」の商品マスターを検索した結果は以下の通りになります。
今回のサンプルでは検索条件を複数指定しています。検索項目の各セルに条件が入力された場合、その項目の条件をSQLで作成します。
・カテゴリー：文字の一部が含んでいればOK
・品名：文字の一部が含んでいればOK
・在庫：数字の範囲指定（項目がどちらかしか入力されていない場合は指定された数値以上、もしくは数値以下全てを検索対象にしています）
VBAサンプルコード
Sub Search() Dim adoCON As New ADODB.Connection Dim adoRS As New ADODB.Recordset Dim strSQL As String Dim odbdDB As Variant Dim strConnector As String 'データベースのパスを取得（ExcelブックをDBとする） odbdDB = ActiveWorkbook.Path & "\sample_20171204.xlsm" 'データベースに接続する Set adoCON = New ADODB.Connection With adoCON .Provider = "Microsoft.ACE.OLEDB.12.0" .Properties("Extended Properties") = "Excel 12.0" .Open odbdDB End With 'カーソルをクライアント側に設定 adoRS.CursorLocation = adUseClient strConnector = "" 'シート「商品マスター」をテーブルとしてSQLを発行 strSQL = "SELECT * FROM [商品マスター$] " '検索条件：カテゴリー If Range("B1").Value <> "" Then If strConnector = "" Then strConnector = "WHERE" Else strConnector = "AND" End If strSQL = strSQL & strConnector & " カテゴリー LIKE '%" & Range("B1").Value & "%' " End If '検索条件：品名 If Range("B2").Value <> "" Then If strConnector = "" Then strConnector = "WHERE" Else strConnector = "AND" End If strSQL = strSQL & strConnector & " 品名 LIKE '%" & Range("B2").Value & "%' " End If '検索条件：在庫数 If Range("B3").Value <> "" Or Range("D3").Value <> "" Then '入力チェック If Range("B3").Value <> "" And IsNumeric(Range("B3").Value) = False Then MsgBox "在庫欄には数字を入力して下さい！" Exit Sub End If If Range("D3").Value <> "" And IsNumeric(Range("D3").Value) = False Then MsgBox "在庫欄には数字を入力して下さい！" Exit Sub End If If strConnector = "" Then strConnector = "WHERE" Else strConnector = "AND" End If '指定した数値の範囲 If Range("B3").Value <> "" And Range("D3").Value <> "" Then '入力チェック If Range("B3").Value > Range("D3").Value Then MsgBox "入力された数字の範囲が間違えています！" Exit Sub End If strSQL = strSQL & strConnector & " (在庫数 >= " & Range("B3").Value & " " _ & " AND 在庫数 <= " & Range("D3").Value & ") " End If '指定した数値以上全て If Range("B3").Value <> "" And Range("D3").Value = "" Then strSQL = strSQL & strConnector & " 在庫数 >= " & Range("B3").Value & " " End If '指定した数値以下全て If Range("B3").Value = "" And Range("D3").Value <> "" Then strSQL = strSQL & strConnector & " 在庫数 <= " & Range("D3").Value & " " End If End If 'レコードセットを開く adoRS.Open strSQL, adoCON, adOpenDynamic '検索結果シートを一旦クリア Worksheets("検索結果").Cells.Clear '検索結果をシートに貼り付ける Worksheets("検索結果").Range("A1").CopyFromRecordset adoRS Worksheets("検索結果").Select 'クローズ処理 adoRS.Close Set adoRS = Nothing adoCON.Close Set adoCON = NothingEnd SubVBAコードの補足
ADOを使用してExcelに接続する
11～20行目でExcelのワークブックをMicrosoft Jet OLE DB Providerを使用して接続します。
'データベースのパスを取得（ExcelブックをDBとする） odbdDB = ActiveWorkbook.Path & "\sample_20171204.xlsm" 'データベースに接続する Set adoCON = New ADODB.Connection With adoCON .Provider = "Microsoft.ACE.OLEDB.12.0" .Properties("Extended Properties") = "Excel 12.0" .Open odbdDB End Withシート「商品マスター」をレコードセットとして開きます
検索条件（WHERE）を指定してシート「商品マスター」をSQLを発行してOpenメソッドでレコードセットとして開きます。（28～92行目）
サンプルのコードでは入力チェックを行ったり、検索項目に入力した場合に条件（WHERE…AND）を指定するように作成していますので少し複雑になっています。
以下のコードはわかりやすくSQLを単純にして「商品マスター」をレコードセットで開いた参考例です。カテゴリーと品名はワイルドカード（%）を使って文字が一部含んでいれば対象とするようにしています。
strSQL = "SELECT * FROM [商品マスター$] "strSQL = strSQL & " WHERE カテゴリー LIKE '%ぶどう%' "strSQL = strSQL & " AND 品名 LIKE '%巨峰%' "strSQL = strSQL & " AND (在庫数 >= 50 AND 在庫数 <=100) "'レコードセットを開くadoRS.Open strSQL, adoCON, adOpenDynamic
検索結果を表示する
95行目で一旦「検索結果」シートの全てをClearメソッドでクリアしています。
'検索結果シートを一旦クリアWorksheets("検索結果").Cells.Clear98～99行目で検索結果のレコードセットをCopyFromRecordsetメソッドで「検索結果」シートに貼り付けてSelectメソッドでシートを表示します。
'検索結果をシートに貼り付けるWorksheets("検索結果").Range("A1").CopyFromRecordset adoRSWorksheets("検索結果").Select以上、今回はExcelのシートを複数条件で検索するVBAコードでした。
今回のサンプルファイルは以下のリンクからダウンロード可能です。
関連記事
