VBAでユーザーフォーム上にある複数のコンボボックスに、連動するリストを登録する方法をご説明します。
連動させる方法と参照するリストのデータの構造についても併せてご説明します。
コントロールのコンボボックスの追加やリストの生成については「ユーザーフォームにコンボボックスの追加とリスト作成、詳細設定の方法」をご覧ください。
また、入力規則を用いた連動するリストの作成方法については、下記記事をご覧ください。
1.連動するリストを作るためのデータ
まずはユーザーフォームのコンボボックスの操作の前に、連動するリストを作成するためのリストのデータについてご説明します。
連動するリストを作る場合、参照するデータ形式で処理するためのロジックも変わってきます。
2つの連動に限ったリストであれば次のようなデータ形式でも良いかと思います。
1つ目の条件で取得したメーカーをループして列を特定して、その列の商品名を2つ目の条件としてリストに追加するだけになります。
今回はこちらの形式を使用して、サンプルコードを作成します。
もし3つ以上の連動を想定する場合には、次のようにリストのデータ形式で用意すると対応しやすいです。
各項目が紐づいている形式でデータを作成する事で、各リストを紐づいた状態で生成できます。
こちらの形式は「コンボボックスに複数(3つ以上)の連動するリストを登録する」でご紹介します。
2.コンボボックスにリストを追加する方法
データの次はユーザーフォームに設置しているコンボボックスへ、リストを追加する方法についてご説明します。
次のような2つのコンボボックスを設置したユーザーフォームを準備します。
コンボボックスへリストを追加する基本的な方法は次のように記述します。
Object.AddItem "登録する文字列"ユーザーフォームとコンボボックスを指定して「AddItem」で文字列をリストに追加します。
先ほどの1つ目の図の様にAメーカーからDメーカーを追加するには次のように記述します。
ユーザーフォームを表示する
コンボボックスにリストを追加する前に、ユーザーフォームを表示します。
Sub Sample1()
UserForm1.Show vbModeless
End Sub
コンボボックスにリストを追加する
次は、開いているユーザーフォームのコンボボックスにリストを追加します。
後ほど説明しますが、データをループして作成も可能です。
Sub Sample2()
Dim MyCtrl As Object
With UserForm1 'ユーザーフォームを指定
Set MyCtrl = .Controls("ComboBox1")
With MyCtrl
.AddItem "Aメーカー"
.AddItem "Bメーカー"
.AddItem "Cメーカー"
.AddItem "Dメーカー"
End With
End With
End Sub
3.全てのリストを追加して表示する
まず連動したリストを生成する前に、連動していない全てのリストを表示するコードを作ります。
そもそも「何も選択していない」状態では、どちらのコンボボックスも全てのリストが選択できる状態である必要があります。
次に、1つ目のコンボボックスで条件が選択されたら、チェンジイベントで2つ目のリストを再生成させます。
図の1つ目のデータを使用して、リストを追加したいと思います。
リストを追加してユーザーフォームの表示
まずはすべてのリストを追加してユーザーフォームの表示です。
重複のないリストを作成するにはDictionaryを使用します。
Dictionaryの詳細については「Dictionaryの使い方」をご覧ください。
下記サンプルコードは丁寧にリスト生成と登録の手順を分けているため長いコードになりますが、その下に省略した短いサンプルコードも記載しています。
サンプルコード
Sub Sample3()
Dim List1Dic As Object
Dim List2Dic As Object
Dim List1Key As Variant
Dim List2Key As Variant
Dim MaxRow As Long
Dim i As Long
Dim n As Long
Dim Myval As String
Dim DicKey As Variant
Dim ListStr As String
'=========1つ目のリスト作成=========
'条件1つ目のDictionaryを用意
Set List1Dic = CreateObject("Scripting.Dictionary")
For i = 3 To 6 '列をループ
Myval = Cells(3, i).Value 'リストとなるメーカーを格納
'Dictionaryに登録されているか重複判定
If Not List1Dic.exists(Myval) Then
List1Dic.Add Myval, "" 'DictionaryのKeyに登録
End If
Next i
List1Key = List1Dic.keys '格納したKeyを格納
'=========2つ目のリスト作成=========
'条件2つ目のDictionaryを用意
Set List2Dic = CreateObject("Scripting.Dictionary")
For i = 3 To 6 '列をループ
For n = 4 To 9 '行をループ
Myval = Cells(n, i).Value 'リストとなるメーカーを格納
'Dictionaryに登録されているか重複判定
If Not List2Dic.exists(Myval) Then
List2Dic.Add Myval, "" 'DictionaryのKeyに登録
End If
Next n
Next i
List2Key = List2Dic.keys '格納したKeyを格納
'=========コンボボックスにリストを追加=========
With UserForm1 'ユーザーフォームを指定
'1つ目のコンボボックスにリストを追加
With .ComboBox1
.Clear 'リストをクリア
For i = 0 To UBound(List1Key) '条件1のリストをループ
.AddItem List1Key(i) 'リストを追加
Next i
End With
'2つ目のコンボボックスにリストを追加
With .ComboBox2
.Clear 'リストをクリア
For i = 0 To UBound(List2Key) '条件1のリストをループ
.AddItem List2Key(i) 'リストを追加
Next i
End With
.Show vbModeless 'ユーザーフォームを表示
End With
End Sub
コードの説明
基本的にはコメントに記述してしますが、簡単に説明します。
1つ目のリスト、2つ目のリストを作成して、最後にコンボボックス1と2にリストを追加してユーザーフォームを表示しています。
「Set List1Dic = CreateObject(“Scripting.Dictionary”)」でDictionaryをセットして使用できるようにしています。
「For i = 3 To 6」～「Next i」の中に1つ目のリストを作成する処理を記述しています。
「Myval = Cells(3, i).Value」でリストとなる文字列を文字列型の変数へ格納します。
「If Not List1Dic.exists(Myval) Then」で文字列がDictionaryに登録されているか判定しています。
Notを付ける事で、登録されていない=Trueとなります。
「List1Dic.Add Myval」で登録されていないければ、Keyへ登録します。
「List1Key = List1Dic.keys」で作成したKeyを変数に格納しています。
2つ目のリスト作成部分も同様のロジックです。
違う部分は列と行をループしているところです。
リストの生成が完了したら、2つのKeyをリストへ追加です。
「With UserForm1」と「With .ComboBox1」で、ユーザーフォームとコンボボックスを指定します。
「.Clear」ですでに登録されているリストを一度リセットします。
「For i = 0 To UBound(List1Key)」から「Next i」でKeyの要素数分ループします。
「.AddItem List1Key(i)」でコンボボックスにリストを追加します。
これを2つ目のコンボボックスへのリストの登録も同様です。
これでユーザーフォームを開くときに全てのリストを作成できました。
ちょっと省略したコード
上記のSample3はロジックをイメージしやすいように、リストの作成と追加を分けて記述しましたが、次のように重複のないリストの生成と登録を同時に行えます。
重複していないかの判定ついでに、そのままコンボボックスへリストを登録することで、リスト登録部分を省略できるため、コードが短くなりシンプルになりました。
Sub Sample3()
Dim ListDic As Object
Dim MaxRow As Long
Dim i As Long
Dim n As Long
Dim Myval As String
With UserForm1
'=========1つ目のリスト作成=========
'条件1つ目のDictionaryを用意
Set ListDic = CreateObject("Scripting.Dictionary")
.ComboBox1.Clear 'リストをクリア
For i = 3 To 6 '列をループ
Myval = Cells(3, i).Value 'リストとなるメーカーを格納
'Dictionaryに登録されているか重複判定
If Not ListDic.exists(Myval) Then
ListDic.Add Myval, "" 'DictionaryのKeyに登録
.ComboBox1.AddItem Myval
End If
Next i
'=========2つ目のリスト作成=========
'条件2つ目のDictionaryを用意
Set ListDic = CreateObject("Scripting.Dictionary")
.ComboBox2.Clear 'リストをクリア
For i = 3 To 6 '列をループ
For n = 4 To 9 '行をループ
Myval = Cells(n, i).Value 'リストとなるメーカーを格納
'Dictionaryに登録されているか重複判定
If Not ListDic.exists(Myval) Then
ListDic.Add Myval, "" 'DictionaryのKeyに登録
.ComboBox2.AddItem Myval
End If
Next n
Next i
.Show vbModeless 'ユーザーフォームを表示
End With
End Sub4.連動するリストを作成する
すべてのリストを登録してユーザーフォームを開いたら、次は1つ目の条件を選んだ場合に2つ目の条件を絞り込んだ状態のリストへ再生成する方法です。
リストを再生成するには一旦コンボボックスをリセットします。
そして1つ目のコンボボックスを条件に2つ目のリストを再生成します。
1つ目の条件でリストを絞り込み
1つ目のリストはそのままなので、2つ目のリスト生成のみ作成します。
単純に2つ目のコードを生成する際に、条件となる1つ目のコンボボックスの値をIF文で分岐して、Trueの場合のみリストに登録するだけです。
Sub Sample4()
Dim List2Dic As Object
Dim i As Long
Dim n As Long
Dim Myval As String
With UserForm1
.ComboBox2.Clear
'=========2つ目のリスト作成=========
'条件2つ目のDictionaryを用意
Set List2Dic = CreateObject("Scripting.Dictionary")
For i = 3 To 6 '列をループ
If Cells(3, i) = .ComboBox1.Value Then
For n = 4 To 9 '行をループ
Myval = Cells(n, i).Value 'リストとなるメーカーを格納
'Dictionaryに登録されているか重複判定
If Not List2Dic.exists(Myval) Then
List2Dic.Add Myval, "" 'DictionaryのKeyに登録
.ComboBox2.AddItem Myval
End If
Next n
Exit For
End If
Next i
End With
End SubBを選択した状態で、上記コードを実行するとコンボボックス2は絞り込まれたリストになりました。
ですが、これでは毎回Sample4を実行する必要があるため、自動で絞り込むようにします。
チェンジイベントで2つ目のリスト生成を自動実行
上記で作成したSample4のコードを、コンボボックス1のチェンジイベントに記述することで、コンボボックス1が変更されるたびにリストが再生成されます。
チェンジイベントを作成するには、ユーザーフォームモジュールでコマンドボタン1をダブルクリックする事で自動的に生成されます。
(※他のイベントの場合は、イベントを選択する必要があります。)
Option Explicit
Private Sub ComboBox1_Change()
Call Sample4
End Sub上記チェンジイベントのコードを追加する事で、コンボボックス1を変更するたびにコンボボックス2が自動的に再生成されます。
もしリスト生成と同時に何かしらの処理を行って、コンボボックス1が空白の際にエラーとなる場合は、次のように空白時は再生成を行わないようにすることでエラー回避ができるかもしれません。
Option Explicit
Private Sub ComboBox1_Change()
With UserForm1.ComboBox1
If .Value <> "" Then
Call Sample4
End If
End With
End Sub
