Excel vba でコンボボックスの絞り込みで重複リストをなくしたい

教えてください。
コンボボックスが4つあります。
コンボボックス1から4まで絞り込んで表示したいのですが
コンボボックス2が複数の重複アイテムが表示されます。
★印のところがうまくいきません。
データは添付ファイルのデータを使用しています。
宜しくお願い致します。
Private Sub UserForm_Initialize()
Dim ico As Long
ico = 1
With ThisWorkbook.Worksheets("商品comマスタ")
Do While .Cells(ico, 1) <> ""
ITE = .Cells(ico, 1).Value
flg = 0
For I = 0 To UserForm1.ComboBox1.ListCount - 1
If ITE = UserForm1.ComboBox1.List(I) Then flg = 1
Next I
If flg = 0 Then UserForm1.ComboBox1.AddItem ITE
ico = ico + 1
Loop
End With
End Sub

Private Sub ComboBox1_Change()
'ComboBox2セット
Dim ico As Long
ico = 1 '読み込みＹ座標
With ThisWorkbook.Worksheets("商品comマスタ")
key = UserForm1.ComboBox1.Text '１つ前の値をキーにする
UserForm1.ComboBox2.Clear 'コンボボックスクリア
Do While .Cells(ico, 1) <> "" 'リストの最後までループ
If .Cells(ico, 1) = key Then 'Ａ列がキーの値だったら
ITE = .Cells(ico, 2).Value 'Ｂ列の値をＩＴＥに
flg = 0 '追加フラグ
If ITE = UserForm1.ComboBox2.List(I) Then flg = 1 'ＩＴＥの値がすでにコンボボックス２に入っている
For I = 0 To UserForm1.ComboBox2.ListCount - 1 'コンボボックス２をループ
If ITE <> Worksheets("商品comマスタ").Cells(ico + 2, 2).Value Then '★
ITE = Worksheets("商品comマスタ").Cells(ico + 2, 2).Value
End If
Next
If flg = 0 Then UserForm1.ComboBox2.AddItem ITE 'ＦＬＧが０だったらＩＴＥをコンボボックスに追加

End If
ico = ico + 1
Loop
End With
UserForm1.ComboBox2.SetFocus
End Sub

Private Sub ComboBox2_Change()
'ComboBox3セット
Dim ico As Long
ico = 1
With ThisWorkbook.Worksheets("商品comマスタ")
key = UserForm1.ComboBox1.Text
key1 = UserForm1.ComboBox2.Text
UserForm1.ComboBox3.Clear
Do While .Cells(ico, 1) <> ""
If .Cells(ico, 1) = key And .Cells(ico, 2) = key1 Then
ITE = .Cells(ico, 3).Value
flg = 0
For I = 0 To UserForm1.ComboBox3.ListCount - 1
If ITE = UserForm1.ComboBox3.List(I) Then flg = 1
Next
If flg = 0 Then UserForm1.ComboBox3.AddItem ITE
End If
ico = ico + 1
Loop
End With
UserForm1.ComboBox3.SetFocus
End Sub

Private Sub ComboBox3_Change()
'ComboBox4セット
Dim ico As Long
ico = 1
With ThisWorkbook.Worksheets("商品comマスタ")
key = UserForm1.ComboBox1.Text
key1 = UserForm1.ComboBox2.Text
key2 = UserForm1.ComboBox3.Text
UserForm1.ComboBox4.Clear
Do While .Cells(ico, 1) <> ""
If .Cells(ico, 1) = key And .Cells(ico, 2) = key1 And .Cells(ico, 3) = key2 Then
ITE = .Cells(ico, 4).Value
flg = 0
For I = 0 To UserForm1.ComboBox4.ListCount - 1
If ITE = UserForm1.ComboBox4.List(I) Then flg = 1
Next
If flg = 0 Then UserForm1.ComboBox4.AddItem ITE
End If
ico = ico + 1
Loop
End With
UserForm1.ComboBox4.SetFocus
End Sub

Private Sub ComboBox4_Change()
'ComboBox5セット
Dim ico As Long
ico = 1
With ThisWorkbook.Worksheets("商品comマスタ")
key = UserForm1.ComboBox1.Text
key1 = UserForm1.ComboBox2.Text
key2 = UserForm1.ComboBox3.Text
key3 = UserForm1.ComboBox4.Text
UserForm1.ComboBox5.Clear
Do While .Cells(ico, 1) <> ""
If .Cells(ico, 1) = key And .Cells(ico, 2) = key1 And .Cells(ico, 3) = key2 And .Cells(ico, 4) = key3 Then
ITE = .Cells(ico, 5).Value
flg = 0
For I = 0 To UserForm1.ComboBox5.ListCount - 1
If ITE = UserForm1.ComboBox5.List(I) Then flg = 1
Next
If flg = 0 Then UserForm1.ComboBox5.AddItem ITE
End If
ico = ico + 1
Loop
End With
UserForm1.ComboBox5.SetFocus
End Sub

質問者からの補足コメント

• 

  めぐさん、絞り込みをしたいので結局サブシートでも同じことになるんです。
  やっぱり無理なんでしょうか？

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/04/18 10:06

• 

  bonaronさん、アドバイス有難う御座います。
  位置ですか？
  先に重複無のデータを配列してからループですか？
  やってみます。

  No.1の回答に寄せられた補足コメントです。 補足日時：2021/04/18 10:17

No.6 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/04/18 12:27

コンボボックス２のみ修正しました。

ITEを明示的に宣言していない為、Forのループの中でITEの値が正しく評価されていないようです。明示的に宣言しました。
Option Explicitを1行目に記述し、全ての変数を明示的に宣言することを推奨します。それを行っていれば、今回のようなエラーは発生しません。
ico=1の場合、見出し行も対象になりますが、よろしいのでしょうか。
（コンボボックス２では実害がないが、コンボボックス１で実害があります）



Private Sub ComboBox1_Change()
'ComboBox2セット
Dim ico As Long
Dim ITE As String
ico = 1 '読み込みＹ座標
With ThisWorkbook.worksheets("商品comマスタ")
key = UserForm1.ComboBox1.Text '１つ前の値をキーにする
UserForm1.ComboBox2.Clear 'コンボボックスクリア
Do While .Cells(ico, 1) <> "" 'リストの最後までループ
If .Cells(ico, 1) = key Then 'Ａ列がキーの値だったら
ITE = .Cells(ico, 2).Value 'Ｂ列の値をＩＴＥに
flg = 0 '追加フラグ
For i = 0 To UserForm1.ComboBox2.ListCount - 1 'コンボボックス２をループ
If ITE = UserForm1.ComboBox2.List(i) Then flg = 1 'ＩＴＥの値がすでにコンボボックス２に入っている
Next
If flg = 0 Then UserForm1.ComboBox2.AddItem ITE 'ＦＬＧが０だったらＩＴＥをコンボボックスに追加
End If
ico = ico + 1
Loop
End With
UserForm1.ComboBox2.SetFocus
End Sub

この回答へのお礼

tatsumaru77さん、有難う御座います。
うまく行きました。
希望どおりに絞り込みができ、表示アイテムも重複無です。
何度もやり直していたのでコードミスしてました。
有難う御座いました。

お礼日時：2021/04/18 16:08

No.7 回答者： めぐみん_ 回答日時： 2021/04/18 15:41

抽出を前に戻った際の対処法で悩みました。

Private myDic As Object
Private keyN(1 To 4) As String

Private Sub UserForm_Initialize()
Dim r As Range

Set myDic = CreateObject("Scripting.Dictionary")

With Worksheets("商品comマスタ")

UserForm1.ComboBox1.Clear

For Each r In Range("A1", Cells(Rows.Count, "A").End(xlUp)) 'A1~で良いのかな？

If Not myDic.Exists(r.Text) Then
myDic.Add r.Text, CreateObject("Scripting.Dictionary")
UserForm1.ComboBox1.AddItem r.Text
End If

If Not myDic(r.Text).Exists(r.Range("B1").Text) Then _
myDic(r.Text).Add r.Range("B1").Text, CreateObject("Scripting.Dictionary")

If Not myDic(r.Text)(r.Range("B1").Text).Exists(r.Range("C1").Text) Then _
myDic(r.Text)(r.Range("B1").Text).Add r.Range("C1").Text, CreateObject("Scripting.Dictionary")

If Not myDic(r.Text)(r.Range("B1").Text)(r.Range("C1").Text).Exists(r.Range("D1").Text) Then _
myDic(r.Text)(r.Range("B1").Text)(r.Range("C1").Text).Add r.Range("D1").Text, CreateObject("Scripting.Dictionary")

If Not myDic(r.Text)(r.Range("B1").Text)(r.Range("C1").Text)(r.Range("D1").Text).Exists(r.Range("E1").Text) Then _
myDic(r.Text)(r.Range("B1").Text)(r.Range("C1").Text)(r.Range("D1").Text).Add r.Range("E1").Text, ""

Next
End With

End Sub

Private Sub ComboBox1_Change()
Dim key

With UserForm1.ComboBox2
ch_CB (2)

For Each key In myDic(keyN(1)).Keys
.AddItem key
Next
End With

End Sub

Private Sub ComboBox2_Change()
Dim key, i As Integer

If UserForm1.ComboBox2.ListCount = 0 Then Exit Sub

With UserForm1.ComboBox3
ch_CB (3)

For Each key In myDic(keyN(1))(keyN(2)).Keys
.AddItem key
Next
End With

End Sub

Private Sub ComboBox3_Change()
Dim key, i As Integer

If UserForm1.ComboBox3.ListCount = 0 Then Exit Sub

With UserForm1.ComboBox4
ch_CB (4)

For Each key In myDic(keyN(1))(keyN(2))(keyN(3)).Keys
.AddItem key
Next
End With

End Sub

Private Sub ComboBox4_Change()
Dim key, i As Integer

If UserForm1.ComboBox4.ListCount = 0 Then Exit Sub

With UserForm1.ComboBox5
ch_CB (5)

For Each key In myDic(keyN(1))(keyN(2))(keyN(3))(keyN(4)).Keys
.AddItem key
Next
End With
End Sub

Private Sub ch_CB(n As Integer)
Dim i As Integer

For i = n To 5
With UserForm1.Controls("ComboBox" & i)
.Clear
.ListIndex = -1
End With
Next

For i = 1 To 4
keyN(i) = UserForm1.Controls("ComboBox" & i).Value
Next
End Sub

はてさて動いてくれるものなのか・・・な？

この回答へのお礼

めぐさん、色々考えてアドバイス頂いて有難うござました。
どうもタイプミスのようです。
tatsumaru77さんのご指摘のように
If ITE <> Worksheets("商品comマスタ").Cells(ico + 2, 2).Value Then '★
ITE = Worksheets("商品comマスタ").Cells(ico + 2, 2).Value
不要のようです。
有難うございました。

お礼日時：2021/04/18 16:15

No.5 回答者： めぐみん_ 回答日時： 2021/04/18 11:29

絞り込みは何とか出来るでしょうけど、私の検証中の物では仮にCombobox3まで絞り込んだ後でCombobox1でエラーになるなど、飛び越えたコントロールを操作した場合の回避について悩み中です。

やっぱジャグ配列は厳しいかなぁ。
コレクションは経験ないので回避されているのかもですが。

No.4 回答者： Qchan1962 回答日時： 2021/04/18 09:49

おはようございます。

コードを読むと、重複しないリストを作る方法が上手くいかないようですね。
最初は、UserForm1.ComboBox2.Clearなので、ここは、
If ITE = UserForm1.ComboBox2.List(I) Then flg = 1 'ＩＴＥの値がすでにコンボボックス２に入っている
Listがないのでエラーになるのでは無いかと思います。
なので、if UserForm1.ComboBox2.ListCount=0 Then　のようなコードが必要かと、
最初の値は、すんなり 'コンボボックス２をループせずに
UserForm1.ComboBox2.AddItem ITE　

For I = 0 To UserForm1.ComboBox2.ListCount - 1 'コンボボックス２をループ
If ITE <> Worksheets("商品comマスタ").Cells(ico + 2, 2).Value Then '★
また、2つ下の行の値を取得しに行っているようですが、試していないので解らないのですが、それで間違えないのでしょうか、
１つずつ値を検証する必要があるように思います。

ソートなどをしているのかも知れませんが、予測できない行に重複データがあるとご質問に書かれている方法だとComboBoxと言う事もあり、大変かもしれませんね。

VBAの場合、重複しないデータを作成する方法は、連想配列やCollectionオブジェクト、AdvancedFilterなど、色々あります。

最近、連想配列をよく見かけますが、データ加工などしないでリストを作るだけなら私的にはコレクションをよく使います。

ごめんなさい。ちょっと分かり難いかも知れませんが、使っているものの改造で作ってしまいました。Collectionオブジェクトを使っています。

下記は、ご質問の内容と離れ、余計なお世話だと思います。
興味があれば参考にされてください。

UserForm_Initializeに書いているコードを参考にしてみてください。

'参照シート名、親ComboBoxの選択値（配列）、登録ComboBoxの番号、参照列番号
Sub ComboBox_list(SHname As String, myKey() As String, CtlN As Integer, colmN As Integer)
Dim i As Long, j As Integer, cnt As Integer, flag As Boolean
Dim Combo_list As New Collection
Controls("ComboBox" & CtlN).Clear
With Worksheets(SHname)
For i = 1 To .Cells(Rows.Count, colmN).End(xlUp).Row
For j = LBound(myKey) To UBound(myKey)
If .Cells(i, j + 1).Value = myKey(j) Then cnt = cnt + 1
Next j
If cnt = UBound(myKey) + 1 Then
If .Cells(i, colmN).Offset(, -1).Value = myKey(cnt - 1) Then
On Error Resume Next
Combo_list.Add .Cells(i, colmN).Value, CStr(.Cells(i, colmN).Value)
If Err.Number = 0 Then
Controls("ComboBox" & CtlN).AddItem .Cells(i, colmN).Value
End If
On Error GoTo 0
End If
End If
cnt = 0
Next
End With
End Sub

Private Sub UserForm_Initialize()
Dim i As Long
Dim Combo_list As New Collection
With Worksheets("商品comマスタ")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
Combo_list.Add .Cells(i, 1).Value, CStr(.Cells(i, 1).Value)
If Err.Number = 0 Then
Controls("ComboBox" & 1).AddItem .Cells(i, 1).Value
End If
On Error GoTo 0
Next
End With
End Sub

Private Sub ComboBox1_Change()
'ComboBox2セット Dim i As Long
Dim myArray(0) As String
myArray(0) = Controls("ComboBox" & 1)
Call ComboBox_list("商品comマスタ", myArray, 2, 2)
Me.ComboBox2.SetFocus
End Sub

Private Sub ComboBox2_Change()
'ComboBox3セット
Dim i As Long
Dim myArray(1) As String
For i = 0 To 1
myArray(i) = Controls("ComboBox" & i + 1)
Next i
Call ComboBox_list("商品comマスタ", myArray, 3, 3)
Me.ComboBox3.SetFocus
End Sub

Private Sub ComboBox3_Change()
Private Sub ComboBox4_Change()
の内容は上記を参考に組んでみてください。
ComboBox2_Change同様、必要項目でSub ComboBox_listを呼べば対応できると思います。

なさりたい事を誤解していたらごめんなさい。

No.3 回答者： めぐみん_ 回答日時： 2021/04/18 09:01

No.2です。

あ！絞り込みたいんでしたっけ。
だとしたらあの回答はダメですね。
Dictionaryオブジェクトでジャグ配列組むかもですがデータ量によってはパンクするかな？

No.2 回答者： めぐみん_ 回答日時： 2021/04/18 08:01

For I = 0 To UserForm1.ComboBox2.ListCount - 1 'コンボボックス２をループ

If ITE <> Worksheets("商品comマスタ").Cells(ico + 2, 2).Value Then '★
ITE = Worksheets("商品comマスタ").Cells(ico + 2, 2).Value
End If
Next

ここって条件が成立すると変数：ITEに代入するけど、その後何もなくループは続くので次にまた条件が成立するとITEの中身が変わってしまうだけでしかないのでは？

具体的に何をしたいのかがわかってない（寝ぼけてるから！）ので何ですけど、Comboboxの値を切り替えるたびに大ごとな作業を行なっている気もしなくもない。
読み込みたい列をそれぞれ必要とするなら、別シートにそれぞれの列？毎に重複しない値を準備しておいてから読み込ませるのも手ではないかなと。

http://blog.jmiri.net/?p=1949

メインのシートからデータをコピペしたサブシートで、１列単位で重複する値を消しちゃうってのはダメな物なの？
⇒該当しない組み合わせが出来ちゃう危険もあるのか・・・な？

この回答へのお礼

めぐさん、返答有難う御座います。
絞り込みたいのです。
選択して表示最終的には登録したいのです。

お礼日時：2021/04/18 10:01

No.1 回答者： bonaron 回答日時： 2021/04/18 02:24

この行の位置がおかしい、と思う。

For I = 0 To UserForm1.ComboBox2.ListCount - 1 'コンボボックス２をループ