VBAでのコンボボックスの連動について

VBAのコンボボックスについての質問です。
画像のようなデータがあったとして
フォームのコンボボックスで会社を選択すると、その会社の商品が一覧として出てきて
さらに商品を選択すると味の一覧が出てきて、その後商品のサイズが選択できるような処理をしたいです。
ただし、コンボボックスには、A社、A社･･･B社、B社･･･のように重複するのではなく、A社、B社のように出てくるようにしたいです。

No.1 ベストアンサー 回答者： siffon9 回答日時： 2016/02/14 21:35

こんな感じで如何でしょう？

以下を当該のユーザーフォームに入力してください。
元の表は、アクティブなシートのA1:D15に書かれていることが前提になります。
Ckaisha,Cshoshin,Caji,Csizeが、それぞれ会社、商品、味、サイズの各コンボボックス名になります。

※私の環境(Win10 64bit/Excel2013)では、イベント連鎖抑止目的でApplication.EnableEventsが上手く機能しなかったので、flagというモジュール内変数を宣言して代わりに使用しました。

---------------------------------------------------------
Option Explicit

Private flag As Boolean

Private Sub UserForm_initialize()
flag = True
Call makeKaishaList(Range("A2:A15"))
flag = False
End Sub

Private Sub Ckaisha_Change()
If flag Then
Exit Sub
End If
flag = True
Call makeShohinList(Range("B2:B15"))
flag = False
End Sub

Private Sub Cshohin_Change()
If flag Then
Exit Sub
End If
flag = True
Call makeAjiList(Range("C2:C15"))
flag = False
End Sub

Private Sub Caji_Change()
If flag Then
Exit Sub
End If
flag = True
Call makeSizeList(Range("D2:D15"))
flag = False
End Sub

Private Sub makeKaishaList(ByRef r As Range)
Dim rng As Range
Dim i As Long
Dim f As Boolean

Ckaisha.Clear
For Each rng In r
f = False
With Ckaisha
For i = 0 To .ListCount - 1
If rng.Value = .List(i) Then
f = True
Exit For
End If
Next i
If Not f Then
.AddItem rng.Value
End If
End With
Next
Ckaisha.ListIndex = 0
Call makeShohinList(r.offset(0, 1))
End Sub

Private Sub makeShohinList(r As Range)
Dim rng As Range
Dim i As Long
Dim f As Boolean

If Ckaisha.Text = "" Then
MsgBox "選択されていない項目があります。", vbExclamation
Exit Sub
End If
Cshohin.Clear
For Each rng In r
f = False
If rng.offset(0, -1).Value <> Ckaisha.Text Then GoTo L_CONTINUE
With Cshohin
For i = 0 To .ListCount - 1
If rng.Value = .List(i) Then
f = True
Exit For
End If
Next i
If Not f Then
.AddItem rng.Value
End If
End With
L_CONTINUE:
Next
Cshohin.ListIndex = 0
Call makeAjiList(r.offset(0, 1))
End Sub

Private Sub makeAjiList(r As Range)
Dim rng As Range
Dim i As Long
Dim f As Boolean

If Ckaisha.Text = "" Or Cshohin.Text = "" Then
MsgBox "選択されていない項目があります。", vbExclamation
Exit Sub
End If
Caji.Clear
For Each rng In r
f = False
If rng.offset(0, -2).Value <> Ckaisha.Text Then GoTo L_CONTINUE
If rng.offset(0, -1).Value <> Cshohin.Text Then GoTo L_CONTINUE
With Caji
For i = 0 To .ListCount - 1
If rng.Value = .List(i) Then
f = True
Exit For
End If
Next i
If Not f Then
.AddItem (rng.Value)
End If
End With
L_CONTINUE:
Next
Caji.ListIndex = 0
Call makeSizeList(r.offset(0, 1))
End Sub

Private Sub makeSizeList(r As Range)
Dim rng As Range
Dim i As Long
Dim f As Boolean

If Ckaisha.Text = "" Or Cshohin.Text = "" Or Caji.Text = "" Then
MsgBox "選択されていない項目があります。", vbExclamation
Exit Sub
End If
Csize.Clear
For Each rng In r
f = False
If rng.offset(0, -3).Value <> Ckaisha.Text Then GoTo L_CONTINUE
If rng.offset(0, -2).Value <> Cshohin.Text Then GoTo L_CONTINUE
If rng.offset(0, -1).Value <> Caji.Text Then GoTo L_CONTINUE
With Csize
For i = 0 To .ListCount - 1
If rng.Value = .List(i) Then
f = True
Exit For
End If
Next i
If Not f Then
.AddItem (rng.Value)
End If
End With
L_CONTINUE:
Next
Csize.ListIndex = 0
End Sub

この回答へのお礼

ありがとうございました！
ほぼ希望通りの動作になりました。
これを機にもう少しVBAを勉強してみたいと思います。

お礼日時：2016/02/15 01:46