Excel (VBA) - 用户窗体组合框 > 列表框，停止重复

Question

从组合框中选择类别后，列表框会更新，仅包含与组合框选择相关的记录。然而，该列表产生了重复，我想知道如何防止这种情况发生。

Private Sub ProdComp_Change()
Dim RowMax As Integer
Dim ws As Worksheet
Dim countexit As Integer
Dim cellcombo2 As String
Dim i As Integer

Set ws = ThisWorkbook.Sheets("products")
RowMax = ws.Cells(Rows.Count, "B").End(xlUp).Row

Me.LBType.Clear

With LBType
    For i = 2 To RowMax
        If ws.Cells(i, "B").Value = ProdComp.Text Then
        .AddItem ws.Cells(i, "c").Value
        Else
        End If
    Next i
End With

End Sub

Worksheet View

UserForm View

Answer 1

尝试将项目添加到唯一的集合，然后将该集合添加到列表框。这样你就不会得到任何重复。

试试这个

Private Sub ProdComp_Change()
    '~~> when working with Rows, Please do not use `Integer`. Use `Long`
    Dim RowMax As Long, countexit As Long, i As Long
    Dim ws As Worksheet
    Dim cellcombo2 As String
    Dim col As New Collection, itm As Variant

    Set ws = ThisWorkbook.Sheets("products")
    RowMax = ws.Cells(Rows.Count, "B").End(xlUp).Row

    For i = 2 To RowMax
        If ws.Cells(i, "B").Value = ProdComp.Text Then
            '~~> On error resume next will
            '~~> create a unique collection
            On Error Resume Next
            col.Add ws.Cells(i, "c").Value, CStr(ws.Cells(i, "c").Value)
            On Error GoTo 0
        End If
    Next i

    Me.LBType.Clear

    If col.Count > 0 Then
        For Each itm In col
            LBType.AddItem itm
        Next
    End If
End Sub

如果数据过多，则可以将数据复制到数组中，而不是遍历行然后创建唯一集合。

Answer 2

你可以试试这个...

Private Sub ProdComp_Change()
Dim RowMax As Integer
Dim ws As Worksheet
Dim countexit As Integer
Dim cellcombo2 As String
Dim i As Integer
Dim dict

Set ws = ThisWorkbook.Sheets("products")
RowMax = ws.Cells(Rows.Count, "B").End(xlUp).Row
Set dict = CreateObject("Scripting.Dictionary")

Me.LBType.Clear

With LBType
    For i = 2 To RowMax
        If ws.Cells(i, "B").Value = ProdComp.Text Then
            dict.Item(ws.Cells(i, "c").Value) = ""
        End If
    Next i
    If dict.Count > 0 Then .List = dict.keys
End With
End Sub