Question

我需要从excel表中填充两个组合框，数据如下：

Column   | A Column B
----------------------
A | 1
A | 2
A | 3
A | 3
A | 5
B |10
B | 11
B | 12
A | 1 
A | 5
A | 2

因此，根据以上数据，一个组合框应该包含唯一值A＆amp;乙

在从第一个组合框A或B中选择一个值时，应在第二个组合框中填充相应的值。

所以数据应如下所示：

如果在第一个组合框中选择了A，则第二个组合框应仅显示值1,2,3,4＆amp; 5。如果在第一个组合框中选择了B，那么第二个组合框应该只显示值10,11＆amp; 12。

因为我有以下代码： -

 Private Sub ComboBox1_Change()

 Dim rng As Range
 Set rng = Sheet2.Range("B2", Sheet2.Cells(Rows.Count, "b").End(xlUp))

 Set oDictionary = CreateObject("Scripting.Dictionary")
 Sheet1.ComboBox2.Clear

 With Sheet1.ComboBox2
For Each cel In rng
If ComboBox1.Value = cel.Offset(, -1).Value Then

        oDictionary(cel.Value) = 0
        .AddItem (cel.Value)

    End If
   Next cel
   End With
  End Sub


  Private Sub ComboBox1_DropButtonClick()

  Dim rng As Range



 Set rng = Sheet2.Range("A2", Sheet2.Cells(Rows.Count, "A").End(xlUp))

 Set oDictionary = CreateObject("Scripting.Dictionary") 'to put uniqe values     from rng variable to combo box1
  With oDictionary
  For Each cel In rng
  If Not .exists(cel.Value) Then
        .Add cel.Value, Nothing
    End If
  Next cel

Sheet1.ComboBox1.List = .keys
End With
End Sub

问题是它的组合框没有显示唯一值。

我如何在combobox2中获得唯一值。

你可以忽略我的编码并提供最简单的方法来完成上述任务......

提前感谢...

Answer 1

在填充字典时，您需要检查当前键的值集是否已包含当前值。

我会使用数组来保存每个键的ColB中的各种值：

Option Explicit

Dim Dic As Object

Private Sub ComboBox1_Change()
    With ComboBox2
        .List = Dic.Item(ComboBox1.Value)
        .Value = "" '### clear any previous selection
    End With
End Sub

Private Sub ComboBox1_DropButtonClick()

    Dim rng As Range
    Dim Dn As Range, arr, v

    Set rng = Sheet2.Range("A2", Sheet2.Cells(Rows.Count, "A").End(xlUp))

    Set Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
    For Each Dn In rng

        v = Dn.Offset(0, 1)

        If Not Dic.exists(Dn.Value) Then
            Dic.Add Dn.Value, Array(v)
        Else
            arr = Dic(Dn.Value)
            'no match will return an error value: test for this
            If IsError(Application.Match(v, arr, 0)) Then
                ReDim Preserve arr(UBound(arr) + 1)
                arr(UBound(arr)) = v
                Dic(Dn.Value) = arr 'replace with expanded array
            End If
        End If

    Next

    ComboBox1.List = Dic.keys
End Sub

Answer 2

使用ArrayList字典

填充组合框

Private oDictionary As Object

Sub RefreshComboBoxes()
    Dim r As Range
    Dim list As Object
    Set oDictionary = CreateObject("Scripting.Dictionary")

    With Sheet1
        For Each r In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

            If Not oDictionary.Exists(r.Text) Then
                Set list = CreateObject("System.Collections.ArrayList")
                oDictionary.Add r.Text, list
            End If
            If Not oDictionary(r.Text).Contains(r.Offset(0, 1).Value) Then
                oDictionary(r.Text).Add r.Offset(0, 1).Value
            End If
        Next
    End With

    ComboBox1.list = oDictionary.Keys
    ComboBox2.Clear

End Sub


Private Sub ComboBox1_Change()
    If ComboBox1.ListIndex > -1 Then
        ComboBox2.Clear
        oDictionary(ComboBox1.Text).Sort
        ComboBox2.list = oDictionary(ComboBox1.Text).ToArray
    End If
End Sub

Private Sub UserForm_Initialize()
    RefreshComboBoxes
End Sub

VBA .Auto根据第一个组合框数据填充第二个组合框中的唯一值

2 个答案:

使用ArrayList字典