Excelのドロップダウンリストに集計した値を設定するVBAコード

Excelのセルにドロップダウンリストを設定するVBAコードをアップします。
今回は前回のサンプルを利用して以下のように商品マスターシートのカテゴリーを表示します。
関連エントリーのコンボボックスの絞り込みと重複した値をまとめて表示する方法についてもご参考下さい。

利用する商品マスターは以下の通りで今回ドロップダウンリストとして表示するのは「カテゴリー」です。

さて、カテゴリー欄を見てわかるとは思いますが、ぶどう・りんご・なしの値が重複しています。このまま利用すると同じものがダラダラとリストに表示されてしまいますので今回はADOを使ってSQL文でカテゴリーの値を集計します。

VBAを作成する準備

ATLキー＋F11キーでVisual Basic Editorを起動します。Editorが起動したら画面左上のプロジェクトからドロップダウンリストを設定するシートをダブルクリックします。

そして以下の図のように「Worksheet」と「SelectionChange」を選択します。これでプロシージャ「Private Sub Worksheet_SelectionChange(ByVal Target As Range)」が作成されます。

これはシートの範囲を変更した際にプログラムを実行してくれるようにするする為です。商品マスターのシートでデータを追加・削除しても指定されたシートのセルの選択を変えると最新の情報に書き換えてくれます。

VBAサンプルコード

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim adoCON          As New ADODB.Connection
    Dim adoRS           As New ADODB.Recordset
    Dim strSQL          As String
    Dim odbdDB          As Variant
    Dim strCat          As String
 
    'データベースのパスを取得（ExcelブックをDBとする）
    odbdDB = ActiveWorkbook.Path & "\sample_20171220.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
         
    'シート「商品マスター」をテーブルとしてSQLを発行
    strSQL = "SELECT カテゴリー FROM [商品マスター$] "
    strSQL = strSQL & " GROUP BY カテゴリー "
    'レコードセットを開く
    adoRS.Open strSQL, adoCON, adOpenDynamic
    
    'リスト用のカテゴリーを取得
    strCat = ""
    Do Until adoRS.EOF
        If strCat = "" Then
            strCat = adoRS!カテゴリー
        Else
            strCat = strCat & ", " & adoRS!カテゴリー
        End If
        adoRS.MoveNext
    Loop
    'レコードセットを閉じる
    adoRS.Close
    
    'リストをセットする
    With Range("B1").Validation
        .Delete
        .Add _
            Type:=xlValidateList, _
            Formula1:=strCat
    End With

    Set adoCON = Nothing
    Set adoRS = Nothing

End Sub

VBAコードの補足

ADOを使用してExcelに接続する

10～19行目でExcelのワークブックをMicrosoft Jet OLE DB Providerを使用して接続します。

'データベースのパスを取得（ExcelブックをDBとする）
odbdDB = ActiveWorkbook.Path & "\sample_20171220.xlsm"
 
'接続する
Set adoCON = New ADODB.Connection

With adoCON
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0"
    .Open odbdDB
End With

シート「商品マスター」をレコードセットとして開きます

SGROUP BYを使って「カテゴリー」を集計するSQLを発行してOpenメソッドでレコードセットとして開きます。（25～28行目）

'シート「商品マスター」をテーブルとしてSQLを発行
strSQL = "SELECT カテゴリー FROM [商品マスター$] "
strSQL = strSQL & " GROUP BY カテゴリー "
'レコードセットを開く
adoRS.Open strSQL, adoCON, adOpenDynamic

集計したレコードセットからドロップダウンリスト用のデータを取得

31～39行目でDo…Loopステートメントでカテゴリーを繰り返し読み込んでドロップダウン用リストを作成します。

'リスト用のカテゴリーを取得
strCat = ""
Do Until adoRS.EOF
    If strCat = "" Then
        strCat = adoRS!カテゴリー
    Else
        strCat = strCat & ", " & adoRS!カテゴリー
    End If
    adoRS.MoveNext
Loop

セルにドロップダウンリストをセットする

44～49行目でセルにドロップダウンリストを設定します。Excelのメニューでは「データ」→「データの入力規制」で設定しますがVBAではValidationオブジェクトを使って設定します。
一旦、セルの入力規制をDeleteメソッドで削除した後、Addメソッドでリストを設定します。

'リストをセットする
With Range("B1").Validation
    .Delete
    .Add _
        Type:=xlValidateList, _
        Formula1:=strCat
End With

以上、今回はセルのドロップダウンリストに重複した値を集計してセットするVBAコードでした。