Excel VBA 複数(3つ以上)のコンボボックスに連動するリストを登録する

コントロール作成/操作

VBAでユーザーフォーム上にある3つ以上の複数のコンボボックスに、連動するリストを登録する方法をご説明します。

連動させる方法と参照するリストのデータの構造についても併せてご説明します。

コントロールのコンボボックスの追加やリストの生成や、2つの連動するリストの登録については下記記事をご覧ください。

1.連動するリストを作るためのデータ

まずはユーザーフォームのコンボボックスの操作の前に、連動するリストを作成するためのリストのデータについてご説明します。

連動するリストを作る場合、参照するデータ形式で処理するためのロジックも変わってきます。

もし3つ以上の連動を想定する場合には、次のようにリストのデータ形式で用意すると対応しやすいです。

縦方向へのデータ量は増えてしまいますが、各項目が紐づいている形式でデータを作成する事で、各リストを紐づいた状態で生成できます。

今回はこちらの形式を使用して、サンプルコードを作成します。

もし2つの連動に限ったリストであれば次のようなデータ形式でも良いかと思います。

1つ目の条件で取得したメーカーをループして列を特定して、その列の商品を2つ目の条件としてリストに追加するだけになります。

こちらの形式は「コンボボックスに複数(2つ)の連動するリストを登録する」をご覧ください。

2.コンボボックスにリストを追加する方法

データの構造の次はユーザーフォームに設置しているコンボボックスへ、リストを追加する方法についてご説明します。

次のような3つのコンボボックスを設置したユーザーフォームを準備します。

コンボボックスへリストを追加する基本的な方法は次のように記述します。

Object.AddItem "登録する文字列"

ユーザーフォームとコンボボックスを指定して「AddItem」で文字列をリストに追加します。

先ほどの1つ目の図の様にAメーカーからDメーカーを追加するには次のように記述します。

ユーザーフォームを表示する

コンボボックスにリストを追加する前に、ユーザーフォームを表示します。

Sub Sample1()

UserForm1.Show vbModeless

End Sub
コンボボックスにリストを追加する

次は、開いているユーザーフォームのコンボボックスにリストを追加します。

後ほど説明しますが、データをループして作成も可能です。

また、リストを追加して、フォームを表示する処理までを、1つのプロシージャに記述しても同じ結果になります。

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つ目のリストを再生成させます。

同じ方法で3つ目以降も組み込みます。

図の1つ目のデータを使用して、リストを追加したいと思います。

リストを追加してユーザーフォームの表示

まずはすべてのリストを追加してユーザーフォームの表示です。

重複のないリストを作成するにはDictionaryを使用します。

Dictionaryの詳細については「Dictionaryの使い方」をご覧ください。

サンプルコード
Sub Sample3()

Dim CheckDic    As Object
Dim MaxRow      As Long
Dim i           As Long
Dim n           As Long
Dim Myval       As String
Dim CtrlInt     As Long
    
With UserForm1

    'データを最終行取得する
    MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    CtrlInt = 1 'コンボボックス名の末尾の番号
            
    For n = 2 To 4 '項目数3列をループ
    
        Set CheckDic = CreateObject("Scripting.Dictionary") '列ごとにDictionaryを初期化

        .Controls("ComboBox" & CtrlInt).Clear'リストをリセット
        
        For i = 3 To MaxRow '3行目から最終行までループ
            
            Myval = Cells(i, n).Value '該当文字列を格納
            
            If Not CheckDic.exists(Myval) Then 'Dictionaryに登録して重複判定
        
                CheckDic.Add Myval, "" 'Dictionaryに登録
                
                'コンボボックスにリストの文字列を登録
                .Controls("ComboBox" & CtrlInt).AddItem Myval
                
            End If
        
        Next i
        
        CtrlInt = CtrlInt + 1 'コンボボックス名の末尾の番号を加算
        
        Set CheckDic = Nothing
        
    Next n
    .Show vbModeless 'ユーザーフォームを表示
End With

End Sub

3つ目のリストのみ表示されていますが、3つのリストがすべて登録されました。

コードの説明

基本的にはコメントに処理内容が記載されていますので、簡単に説明します。

「MaxRow = Cells(Rows.Count, 2).End(xlUp).Row」でリストの行数をループするため、最終行を取得しています。

「CtrlInt = 1」はコンボボックスの名前の末尾の番号を指定するための変数です。

列をループしてコンボボックスの名前の番号を加算する事で、順番にコンボボックスを指定します。

「Set CheckDic = CreateObject(“Scripting.Dictionary”)」でDictionaryを使用できるようにセットしていますが、列ループ内でセットする事で、列がループする毎に初期化されるので各列のリスト生成に使いまわせます。

「.Controls(“ComboBox” & CtrlInt).Clear」で事前に登録されているリストをリセットします。

「For i = 3 To MaxRow」~「Next i」でリストの行数分ループして、重複のないリストの作成処理を記述しています。

「If Not CheckDic.exists(Myval) Then」でリストに登録されているか判定しています。

Notを付ける事で、登録されていないとTrueになります。

「CheckDic.Add Myval」で登録されていない場合は、DictionaryのKeyに登録してその流れで、「.Controls(“ComboBox” & CtrlInt).AddItem Myval」でコンボボックスへリストを追加しています。

4.連動するリストを作成する

次は連動したリストの作成方法です。

今回の方法はメーカー→商品→カラーという絞り込みの依存関係の上に成り立つとします。

全項目に依存関係を持たせようとすると、出来ないこともありませんが非常に複雑になります。

先ほどの様にDictionaryのKeyを単純にリストに設定はできませんので、簡単な方法として各リストの設定を分けて作成する方法です。

ロジックはリストの1つ目が変更されると、2つ目、3つ目のリストを一旦リセットして、条件に一致するリストを再度作成して設定します。

2つ目のリストが変更されると3つ目のリストを一旦リセットして、1つ目と2つ目の条件に一致するリストを再度作成して設定します。

再設定は各コンボボックスが変更されたときのチェンジイベントで分岐します。

上記で説明した「Sample3」と、下記記載の「Sample4~6」は標準モジュールに記述して、各コンボボックスのチェンジイベントを記述する事で、「Sample3」を実行すると連動したコンボボックスが出来上がります。

リストを登録するコード

1つ目のリストを作成するコード

こちらは先ほどのコードから、ユーザーフォームの表示部分を削除したコードです。

1つ目のコンボボックスが空白時に呼び出して、3つのリストボックスをリセットして、新しくリストを生成します。

Sub Sample4()

Dim CheckDic    As Object
Dim MaxRow      As Long
Dim i           As Long
Dim n           As Long
Dim Myval       As String
Dim CtrlInt     As Long
    
With UserForm1

    'データを最終行取得する
    MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    CtrlInt = 1 'コンボボックス名の末尾の番号
            
    For n = 2 To 4 '項目数3列をループ
    
        Set CheckDic = CreateObject("Scripting.Dictionary") '列ごとにDictionaryを初期化

        .Controls("ComboBox" & CtrlInt).Clear 'リストをクリア
        
        For i = 3 To MaxRow '3行目から最終行までループ
            
            Myval = Cells(i, n).Value '該当文字列を格納
            
            If Not CheckDic.exists(Myval) Then 'Dictionaryに登録して重複判定
        
                CheckDic.Add Myval, "" 'Dictionaryに登録
                
                'コンボボックスにリストの文字列を登録
                .Controls("ComboBox" & CtrlInt).AddItem Myval
                
            End If
        
        Next i
        
        CtrlInt = CtrlInt + 1 'コンボボックス名の末尾の番号を加算
        
        Set CheckDic = Nothing
        
    Next n

End With

End Sub
2つ目のリストを作成するコード

1つ目のリストの条件に一致するリストの作成です。

Sub Sample5()

Dim CheckDic    As Object
Dim MaxRow      As Long
Dim i           As Long
Dim n           As Long
Dim Myval       As String
Dim CtrlInt     As Long
    
With UserForm1

    'データを最終行取得する
    MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    CtrlInt = 2 'コンボボックス名の末尾の番号
            
    For n = 3 To 4 '項目数3列をループ
    
        Set CheckDic = CreateObject("Scripting.Dictionary") '列ごとにDictionaryを初期化
        
        .Controls("ComboBox" & CtrlInt).Clear 'リストをクリア
        
        For i = 3 To MaxRow '3行目から最終行までループ
        
            If .ComboBox1.Value = Cells(i, 2) Then 'コンボボックス1と一致するか判定
                
                Myval = Cells(i, n).Value '該当文字列を格納
                
                If Not CheckDic.exists(Myval) Then 'Dictionaryに登録して重複判定
            
                    CheckDic.Add Myval, "" 'Dictionaryに登録
                    
                    'コンボボックスにリストの文字列を登録
                    .Controls("ComboBox" & CtrlInt).AddItem Myval
                    
                End If
                
            End If
        
        Next i
        
        CtrlInt = CtrlInt + 1 'コンボボックス名の末尾の番号を加算
        
        Set CheckDic = Nothing
        
    Next n

End With

End Sub
3つ目のリストを作成するコード

1つ目と、2つ目のリストの条件に一致するリストを作成するコードです。

下記コードは1つ目が未選択で、2つ目のみが選択された場合は、3つ目の条件に一致しなくなります。

この現象を回避するには、1つ目のコンボボックスが空白の場合の分岐処理を組み込む必要があります。

Sub Sample6()

Dim CheckDic    As Object
Dim MaxRow      As Long
Dim i           As Long
Dim n           As Long
Dim Myval       As String
    
With UserForm1

    'データを最終行取得する
    MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    Set CheckDic = CreateObject("Scripting.Dictionary") '列ごとにDictionaryを初期化
    
    .ComboBox3.Clear 'リストをクリア
    
    For i = 3 To MaxRow '3行目から最終行までループ
    
        If .ComboBox1.Value = Cells(i, 2) And _
            .ComboBox2.Value = Cells(i, 3) Then 'コンボボックス1、2と一致するか判定
            
            Myval = Cells(i, 4).Value '該当文字列を格納
            
            If Not CheckDic.exists(Myval) Then 'Dictionaryに登録して重複判定
        
                CheckDic.Add Myval, "" 'Dictionaryに登録
                
                'コンボボックスにリストの文字列を登録
                .ComboBox3.AddItem Myval
                
            End If
            
        End If
    
    Next i
    
    Set CheckDic = Nothing
        
End With

End Sub

コンボボックスのチェンジイベント

各リストの生成の次は、コンボボックスのチェンジイベントです。

3つ目は変更されても他のコンボボックスに影響を与えないため1と2のみとなります。

ComboBox1のチェンジイベント
Private Sub ComboBox1_Change()

    Call Sample5

End Sub
ComboBox2のチェンジイベント
Private Sub ComboBox2_Change()

    Call Sample6
    
End Sub

それぞれのコンボボックスが連動してカラーまで絞り込まれました。

タイトルとURLをコピーしました