フォーム上のリストボックスに重複して表示しています

現在、使用には問題ありませんがリストボックスに重複して表示されています
数が多いので探すのが手間で少々気になります
できれば重複表示しないように出来ればと思います
コードはどのように変更または追加したらできますか？

Private Sub CommandButton3_Click() '検索ボタン
Dim tbl As Variant
Dim i As Long

tbl = Range("D1:N" & Cells(Rows.Count, 4).End(xlUp).Row)
ListBox1.Clear
ListBox2.Clear

For i = 1 To UBound(tbl)
If tbl(i, 2) = ComboBox3.Value And _
tbl(i, 10) = "" And _
tbl(i, 3) = ComboBox4.Value Then


With ListBox2
.AddItem tbl(i, 6)
End With
End If
Next i
End Sub

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

• 

  Qchan1962様
  回答ありがとうございます
  ごめんなさいど素人なためどこに？どの行に追加したらよいのでしょうか？4

  No.1の回答に寄せられた補足コメントです。 補足日時：2022/10/19 13:54

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2022/10/19 14:19

Private Sub CommandButton3_Click()

Dim tbl As Variant
Dim i As Long
tbl = Range("D1:N" & Cells(Rows.Count, 4).End(xlUp).Row)
ListBox1.Clear
ListBox2.Clear
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tbl)
If tbl(i, 2) = ComboBox3.Value And _
tbl(i, 10) = "" And _
tbl(i, 3) = ComboBox4.Value Then
If tbl(i, 6) <> "" Then
If Not dic.Exists(tbl(i, 6)) Then
dic.Add tbl(i, 6), 0
With ListBox2
.AddItem tbl(i, 6)
End With
End If
End If
End If
Next i
Set dic = Nothing
End Sub

この回答へのお礼

とても助かりましたありがとうございました

お礼日時：2022/10/19 14:31

No.2 回答者： fujillin 回答日時： 2022/10/19 14:10

こんにちは

重複を削除する比較的簡単な方法としては、
1）Dictionaryオブジェクトを利用して重複を省く
https://tonari-it.com/excel-vba-dictionary-loopr …

2）シートの空き列を利用して、「重複を削除」機能を利用する
https://learn.microsoft.com/ja-jp/office/vba/api …

などがあると思いますので、どちらかを利用なさるのがよろしいでしょう。


もちろん、登録する際に「同じ値が既にあるかをチェックする」という、プリミティブな方法でも可能です。
　itm = tbl(i, 6).Text ' ← 追加内容
　With ListBox2
　　For j = 0 To .ListCount - 1
　　　If .List(j) = itm Then itm = "": Exit For
　　Next j
　　If itm <> "" Then .AddItem itm
　End With
とか。

No.1 回答者： Qchan1962 回答日時： 2022/10/19 13:23

こんにちは

変更しなくても追加で良いと思いますよ
すでにあるか検証する処理を加えればいいと思いますが・・
まとめて処理したいところですが・・コードを変えずにやるなら
条件にScripting.Dictionaryを使うのはどうでしょう
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

If tbl(i, 2) =　・・・
If tbl(i, 6) <> "" Then
If Not dic.Exists(tbl(i, 6)) Then
dic.Add tbl(i, 6), 0
With ListBox2
.AddItem tbl(i, 6)
End With
End If
End If