Excel VBA中组合框中的唯一值

I want to get the unique values in combobox 2 once I select from combobox1.

一旦从combobox1中选择,我想在组合框2中获得唯一值。

Column A              Column B
--------              --------
Girls                 Hair
Boys                  Hair
Veg                   Water
Non-Veg               Water

Once I select Girls in combobox1 (retrieve from column 'A' in excel), it should show unique value of 'Hair' from column 'B' instead of twice in excel.

一旦我选择了combobox1中的Girls(从excel中的列'A'中检索),它应该在'B'列中显示'Hair'的唯一值,而不是在excel中显示两次。

1 个解决方案

#1

Here are the basics for that kind of linked choices :

以下是这种链接选择的基础知识:

That will implement unique values in ComboBox1 :

这将在ComboBox1中实现唯一值:

Private Sub UserForm_Initialize()
Dim Ws As Worksheet, _
    Dic As Object, _
    rCell As Range, _
    Key 'As String

Set Ws = Worksheets("Sheet1")
Set Dic = CreateObject("Scripting.Dictionary")
UserForm1.ComboBox1.Clear

For Each rCell In Ws.Range("A2", Ws.Cells(Rows.Count, "A").End(xlUp))
    If Not Dic.exists(LCase(rCell.Value)) Then
        Dic.Add LCase(rCell.Value), Nothing
    End If
Next rCell

For Each Key In Dic
    UserForm1.ComboBox1.AddItem Key
Next
End Sub

'And there is the part that put uniques values in ComboBox2 when it matches the criteria with ComboBox1 :

'当ComboBox2与ComboBox1匹配时,有一部分在ComboBox2中放置唯一值:

'When you change the value of the ComboBox1, it'll launch that code, so you need to refresh in there the values proposed in ComboBox2 with your own tests.

'当您更改ComboBox1的值时,它将启动该代码,因此您需要使用自己的测试刷新ComboBox2中提出的值。

Private Sub ComboBox1_Change()

Dim Ws As Worksheet, _
    Dic As Object, _
    rCell As Range, _
    Key 'As String

Set Ws = Worksheets("Sheet1")
Set Dic = CreateObject("Scripting.Dictionary")
Me.ComboBox2.Clear 'Clear all previously added elements
Me.ComboBox2.Value = vbNullString 'Set active value as an empty string

'------Here is where you need to do your tests-------
For Each rCell In Ws.Range("B2", Ws.Cells(Rows.Count, "B").End(xlUp))
    If rCell.Offset(0, -1) <> Me.ComboBox1.Value Then
    Else
        If Not Dic.exists(LCase(rCell.Value)) Then
            Dic.Add LCase(rCell.Value), Nothing
        End If
    End If
Next rCell

For Each Key In Dic
    UserForm1.ComboBox2.AddItem Key
Next
End Sub

And the code for a third combobox :

以及第三个组合框的代码:

Private Sub ComboBox2_Change()

    Dim Ws As Worksheet, _
        Dic As Object, _
        rCell As Range, _
        Key 'As String

    Set Ws = Worksheets("Sheet1")
    Set Dic = CreateObject("Scripting.Dictionary")
    Me.ComboBox3.Clear 'Clear all previously added elements
    Me.ComboBox3.Value = vbNullString 'Set active value as an empty string

    '------Here is where you need to do your tests-------
    For Each rCell In Ws.Range("C2", Ws.Cells(Rows.Count, "C").End(xlUp))
        If rCell.Offset(0, -1) <> Me.ComboBox2.Value And rCell.Offset(0, -2) <> Me.ComboBox1.Value Then
        Else
            If Not Dic.exists(LCase(rCell.Value)) Then
                Dic.Add LCase(rCell.Value), Nothing
            End If
        End If
    Next rCell

    For Each Key In Dic
        UserForm1.ComboBox3.AddItem Key
    Next
    End Sub

#1