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 = Nothing

End Sub

VBAコードの補足

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.Clear

98～99行目で検索結果のレコードセットをCopyFromRecordsetメソッドで「検索結果」シートに貼り付けてSelectメソッドでシートを表示します。

'検索結果をシートに貼り付ける
Worksheets("検索結果").Range("A1").CopyFromRecordset adoRS
Worksheets("検索結果").Select

以上、今回はExcelのシートを複数条件で検索するVBAコードでした。