Excel VBAのユーザーフォームについて質問です。テーブル形式で「社名」・「商品名」があり、それをユーザーフォームのリストボックスで、社名で商品名を絞り込む連動式にしたいのです。パワークエリでクロス型に変換すればできるかなと思い、前回質問させていただいたのですが、思ったようにできなくて困っております。テーブル形式から直接ユーザーフォームにできるのであれば、それに越したことはありません。どなたかご教授のほうよろしくお願いいたします。

掲示されていない構成

前提

ユーザーフォーム構成

セット1 ListBox1 ListBox2

セット2 ListBox3 ListBox4

セット3 ListBox5 ListBox6

セット4 ListBox7 ListBox8

セット5 ListBox9 ListBox10

シートのオブジェクト名

Sheet1

テーブルの名前

テーブル1



処理 表示まで



当該ユーザーフォームモジュールに



Option Explicit



' --- ListBox のペアを配列で管理 ---

Private CompanyLists As Variant ' 社名 ListBox 配列

Private ProductLists As Variant ' 商品 ListBox 配列



Private Sub UserForm_Initialize()

Dim i As Long



'=== ListBox名を配列に格納 ===

CompanyLists = Array(\u0026quot;ListBox1\u0026quot;, \u0026quot;ListBox3\u0026quot;, \u0026quot;ListBox5\u0026quot;, \u0026quot;ListBox7\u0026quot;, \u0026quot;ListBox9\u0026quot;)

ProductLists = Array(\u0026quot;ListBox2\u0026quot;, \u0026quot;ListBox4\u0026quot;, \u0026quot;ListBox6\u0026quot;, \u0026quot;ListBox8\u0026quot;, \u0026quot;ListBox10\u0026quot;)



'=== すべての社名ListBoxに社名一覧をセット ===

For i = LBound(CompanyLists) To UBound(CompanyLists)

LoadCompanyList Me.Controls(CompanyLists(i))

Next i

End Sub



Private Sub LoadCompanyList(lb As MSForms.ListBox)

Dim lo As ListObject, dic As Object

Dim rng As Range, r As Range



Set lo = Sheet1.ListObjects(\u0026quot;テーブル1\u0026quot;)

Set rng = lo.ListColumns(\u0026quot;社名\u0026quot;).DataBodyRange

Set dic = CreateObject(\u0026quot;Scripting.Dictionary\u0026quot;)



lb.Clear



For Each r In rng

If Not dic.Exists(r.Value) Then dic.Add r.Value, r.Value

Next r



lb.List = dic.Items

End Sub



Private Sub FilterProduct(company As String, resultBox As MSForms.ListBox)

Dim lo As ListObject

Dim cmp As Range

Dim prd As Range

Dim i As Long



Set lo = Sheet1.ListObjects(\u0026quot;テーブル1\u0026quot;)

Set cmp = lo.ListColumns(\u0026quot;社名\u0026quot;).DataBodyRange

Set prd = lo.ListColumns(\u0026quot;商品名\u0026quot;).DataBodyRange



resultBox.Clear



For i = 1 To cmp.Rows.Count

If cmp.Cells(i, 1).Value = company Then

resultBox.AddItem prd.Cells(i, 1).Value

End If

Next i

End Sub



Private Sub ListBox_Change(Index As Integer)

If Me.Controls(CompanyLists(Index)).ListIndex = -1 Then Exit Sub



Dim selectedCompany As String

selectedCompany = Me.Controls(CompanyLists(Index)).Value

FilterProduct selectedCompany, Me.Controls(ProductLists(Index))

End Sub



Private Sub ListBox1_Change(): ListBox_Change 0: End Sub

Private Sub ListBox3_Change(): ListBox_Change 1: End Sub

Private Sub ListBox5_Change(): ListBox_Change 2: End Sub

Private Sub ListBox7_Change(): ListBox_Change 3: End Sub

Private Sub ListBox9_Change(): ListBox_Change 4: End Sub