如何不让重复的名称（A 列）出现在组合框中并在新的组合框中填充 B 列名称

Question

我遇到了一个问题，我无法在 "Combo Box 1" 中填充列 A 名称而不重复 。删除重复项后，我需要通过对 A 列值进行分组，将相应的 B 列值填充到 "Combo Box2" 中。我的代码中有什么导致这个问题的吗？任何帮助将不胜感激。

我的 Excel 数据的图像下方：

输出： 当 select "A" 来自 "Combo Box1" （不重复 A 值 3 次）然后它应该填充 "12,2 ,3" 在 "Combo box 2"

下面是 link 组合框名称的代码。

Private Sub cboproj_DropButtonClick()
Dim ssheet As Worksheet
Set ssheet = ThisWorkbook.Worksheets("Sheet1")
    ssheet.Activate
Dim i As Long
If Me.cboproj.ListCount = 0 Then
    For i = 2 To ssheet.Range("A" & ssheet.Rows.Count).End(xlUp).Row
        Me.cboproj.AddItem Sheets("LS numbers").Cells(i, "A").Value
        'remove duplicates
        ssheet.Columns(1).RemoveDuplicates Columns:=Array(1)

    Next i
End If
End Sub

Private Sub cboproj_Change()
Dim ws As Worksheet
Dim i As Long
Dim str As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Activate
For i = 2 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    If ws.Cells(i, "A").Value = (Me.cboproj) Or ws.Cells(i, "A").Value = Val(Me.cboproj) Then
        Me.cbonumber = ws.Cells(i, "B").Value  
        Me.cboloc = ws.Cells(i, "C").Value 
    End If
Next i
End Sub

Answer 1

首先，右键单击所有 3 个组合框并将它们的 Style 从 fmStyleDropDownCombo 更改为 fmStyleDropDownList。这将确保用户无法键入列表中不存在的内容。

逻辑:

在UserForm_Initialize中，对excel中的数据进行排序sheet。这样，当数据被添加到组合框中时，数据将被排序。
将 Excel Col A-B 存储在一个数组中。
创建一个唯一的 Col A 值集合。将集合中的项目添加到 Combobox1。
在 Combobox A 的点击事件中，将 Combobox A 的值与数组第 1 列中的数据匹配，然后填充 Combobox B（先清除 Combobox B）
在 Combobox B 的点击事件中，将 Combobox B 的值与数组第 2 列中的数据匹配，然后填充 Combobox C（先清除 Combobox C）

我的假设

数据存储在代号为Sheet1
Part 必须进去 Combobox1
Nr. 必须进去 Combobox2
Loc 必须进去 Combobox3

因此，在您实施以下内容时，请在代码中进行这些更改。

代码

Option Explicit

Dim MyAr As Variant
Dim i As Long
Dim col As Collection
Dim itm As Variant

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim lRow As Long

    Set col = New Collection

    '~~> Set this to the relevant sheet
    Set ws = Sheet1

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Sort Col A,B and C so that you get sorted data inthe combobox
        With .Sort
            .SortFields.Clear

            .SortFields.Add Key:=Range("A2:A" & lRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

            .SortFields.Add Key:=Range("B2:B" & lRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

            .SortFields.Add Key:=Range("C2:C" & lRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

            .SetRange Range("A1:C" & lRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        '~~> Store the range in an array
        MyAr = .Range("A2:C" & lRow).Value

        '~~> Loop through Col A of the array and
        '~~> Create a unique collection
        For i = LBound(MyAr) To UBound(MyAr)
            On Error Resume Next
            If Len(Trim(MyAr(i, 1))) <> 0 Then
                col.Add MyAr(i, 1), CStr(MyAr(i, 1))
            End If
            On Error GoTo 0
        Next i
    End With

    '~~> Add items to Combobox 1
    If col.Count <> 0 Then
        For Each itm In col
            ComboBox1.AddItem itm
        Next
    End If
End Sub

Private Sub ComboBox1_Click()
    If ComboBox1.ListIndex = -1 Then Exit Sub

    '~~> Clear for input
    ComboBox2.Clear
    ComboBox3.Clear

    '~~> Compare array and fill combobox 2
    For i = LBound(MyAr) To UBound(MyAr)
        If MyAr(i, 1) = ComboBox1.Value Then
           ComboBox2.AddItem MyAr(i, 2)
        End If
    Next i
End Sub

Private Sub ComboBox2_Click()
    If ComboBox2.ListIndex = -1 Then Exit Sub

    ComboBox3.Clear

    Set col = New Collection

    '~~> Compare array and create a unique collection
    For i = LBound(MyAr) To UBound(MyAr)
        If Trim(MyAr(i, 1)) = (ComboBox1.Value) And _
           Trim(MyAr(i, 2)) = (ComboBox2.Value) Then
            On Error Resume Next
            col.Add MyAr(i, 3), CStr(MyAr(i, 3))
            On Error GoTo 0
        End If
    Next i

    '~~> Fill combobox 3
    If col.Count <> 0 Then
        For Each itm In col
            ComboBox3.AddItem itm
        Next
    End If
End Sub

在行动

Answer 2

我的解决方案：

Option Explicit

Dim arr As Variant, value As Variant
Dim dict As Object
Dim i As Long

Private Sub ComboBox1_Change()

    value = Me.ComboBox1.value

    Me.ComboBox2.Clear

    Set dict = CreateObject("Scripting.Dictionary")

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

        If arr(i, 1) = value Then
            dict.Add Key:=arr(i, 2), Item:=i
        End If

    Next i

    For Each value In dict
        Me.ComboBox2.AddItem value
    Next value

End Sub

Private Sub ComboBox1_DropButtonClick()

    Dim LastRow As Long

    Me.ComboBox1.Clear

    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        arr = .Range("A2:B" & LastRow)

        For i = LBound(arr) To UBound(arr)
            If Not dict.Exists(arr(i, 1)) Then
                dict.Add Key:=arr(i, 1), Item:=i
            End If
        Next i

        For Each value In dict
            Me.ComboBox1.AddItem value
        Next value

    End With

End Sub

如何不让重复的名称（A 列）出现在组合框中并在新的组合框中填充 B 列名称

How to not get repeated names(Column A) appear in combobox and populate Column B names in new combo box

excel

vba

userform