依赖字典excel vba

Question

我想知道哪种方法是从一列中获取唯一值的最快方法，然后对于之前在第一列中找到的每个值在另一列中获取唯一值

例子

Column A    Column B

Case 1      Item A
Case 1      Item B
Case 1      Item A
Case 2      Item C
Case 2      Item C
Case 3      Item D
Case 3      Item E
Case 3      Item F
Case 3      Item D

结果应从第一列返回三个值（案例 1、案例 2、案例 3），然后为案例 1（项目 A 和项目 B）返回两个值，为案例 2（项目 C）返回一个值，三个值对于案例 3（项目 D、项目 E、项目 F）

我不想使用高级过滤器或将过滤后的行复制到另一张工作表中。

我尝试使用脚本字典来达到此目的，但我不太了解字典，而且我无法使用第一个字典的键（案例 1，...）作为参数来添加第二个字典中的项目字典（项目 A，...）

理想情况下，最后，宏将为第一个字典的每个键创建一个文本框，然后为每个文本框为第二个字典的每个键创建其他文本框（我是树视图，但使用文本框）

显然，会有一个循环

这是众多暂定词之一（但是，正如我所说，我的字典知识真的很差）

Dim d As Variant, dict As Object
Dim v As Long, a As Variant
Dim vCount As Long
Dim vCount1 As Long

Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare  'default is vbbinarycompare

 With Sheets("Sheet1") '<- alter to suite
a = .Range("a2", Range("a" & Rows.Count).End(xlUp)).Value
' change "a1"/ "a" to appropreate column reference

    'build dictionary
    For v = LBound(a, 1) To UBound(a, 1)
        'overwrite method - faster (no error control)
        'writes name&position as key, ID as item
        'dict.Itema(v, 1)(Join(Array(vVALs(v, 2)
        dict.Item(Join(Array(a(v, 1)), ChrW(8203))) = a(v, 2)
    Next v

Me.ComboBox1.List = dict.Keys
Me.ComboBox2.List = dict.Values
    'loop through the second table
    For v = 2 To .Cells(Rows.Count, 2).End(xlUp).row
        d = (Join(Array(a(v, 1))))
        If dict.Exists(d) Then
            vCount = dict.Item(d)
            MsgBox vCount
            End If
    Next v
End With

如果有第三列怎么办？ 示例

Column A    Column B    Column C

Case 1      Item A      
Case 1      Item B      number 1
Case 1      Item A      number 1
Case 2      Item C      number 2
Case 2      Item C      number 1
Case 3      Item D      number 3
Case 3      Item E      number 1
Case 3      Item F      number 1
Case 3      Item D      number 2

结果应该是

Case 1
     Item A   number1
     Item B   number1
Case 2
     Item C   number1
              number2
Case 3
     Item D   number2
              number3
     Item E   number1
     Item F   number1

这里是我尝试根据 Zev Spitz 建议构建的代码，但没有成功

Dim row As Variant
Dim dict As New Dictionary
For Each row In Sheets("Positioning").Range("h2", Range("p" & 
Rows.Count).End(xlUp)).Rows
Dim caseKey As String
caseKey = row.Cells.Item(2, 1).Value

Dim innerDict As Scripting.Dictionary

If dict.Exists(caseKey) Then
    Set innerDict = dict(caseKey)

Else
    Set innerDict = New Scripting.Dictionary
    Set dict(caseKey) = innerDict

End If


innerDict(row.Cells.Item(2, 3).Value) = 1

Dim outerKey As Variant, innerKey As Variant, inner2Key As Variant
 Dim inner2Dict As Scripting.Dictionary
For Each innerKey In innerDict.Keys
Set inner2Dict = New Scripting.Dictionary
If inner2Dict.Exists(inner2Dict) Then
Set innerDict(innerKey) = inner2Dict

Else
Set inner2Dict = inner2Dict
End If
inner2Dict(row.Cells.Item(2, 8).Value) = 1
Next

Next


For Each outerKey In dict.Keys
Debug.Print outerKey
    For Each innerKey In innerDict.Keys
    Debug.Print vbTab, innerKey
          For Each inner2Key In inner2Dict.Keys
      Debug.Print vbTab, vbTab, inner2Key
      Next
 Next
Next

Answer 1

使用嵌套字典加载数据

您可以使用具有其他字典作为其值的字典：

Dim row As Variant
Dim dict As New Dictionary
For Each row In Worksheets("Sheet1").Range("A1", "B9").Rows
    Dim caseKey As String
    caseKey = row.Cells(1, 1).Value

    Dim innerDict As Scripting.Dictionary
    If dict.Exists(caseKey) Then
        Set innerDict = dict(caseKey)
    Else
        Set innerDict = New Scripting.Dictionary
        Set dict(caseKey) = innerDict
    End If
    innerDict(row.Cells(1, 2).Value) = 1 'an arbitrary value
Next

然后您可以遍历外部字典中的每个键，并遍历内部字典中的每个键。例如以下代码：

Dim outerKey As Variant, innerKey As Variant
For Each outerKey In dict.Keys
    Debug.Print outerKey
    For Each innerKey In dict(outerKey).Keys
        Debug.Print vbTab, innerKey
    Next
Next

将输出以下内容：

Case 1
    Item A
    Item B
Case 2
    Item C
Case 3
    Item D
    Item E
    Item F

有关如何使用字典获取一组唯一值的说明，请参阅here。

---

根据第一个组合框中的选择填充另一个组合框

假设您已将第一个组合框的 List 属性设置为字典的 Keys 集合：

Me.ComboBox1.List = dict.Keys

你可以处理组合框的Change事件，并用它用对应的内部字典的键填充第二个组合框：

Private Sub ComboBox1_Change()
    If Value Is Nothing Then
        Me.ComboBox2.List = Nothing
        Exit Sub
    End If
    Me.ComboBox2.Value = Nothing
    Me.ComboBox2.List = dict(Me.ComboBox1.Value).Keys
End Sub

---

使用 SQL 的唯一值

获取唯一值组合的另一种方法可能是在 Excel 工作表上执行 SQL 语句：

SELECT DISTINCT [Column A], [Column B]
FROM [Sheet1$]

但这通常以 ADO 或 DAO 平面 Recordset 的形式返回——带有字段和行——而嵌套字典保留了这些数据的层次结构。

---

完整的代码隐藏

添加对 Microsoft Scripting Runtime 的引用（工具 > 引用...）

Option Explicit

Dim dict As New Dictionary

Private Sub ComboBox1_Change()
    If Value Is Nothing Then
        Me.ComboBox2.List = Nothing
        Exit Sub
    End If
    Me.ComboBox2.Value = Nothing
    Me.ComboBox2.List = dict(Me.ComboBox1.Value).Keys
End Sub

Private Sub UserForm_Initialize()
    For Each row In Worksheets("Sheet1").Range("A1", "B9").rows
        Dim caseKey As String
        caseKey = row.Cells(1, 1).Value

        Dim innerDict As Dictionary
        If dict.Exists(caseKey) Then
            Set innerDict = dict(caseKey)
        Else
            Set innerDict = New Dictionary
            Set dict(caseKey) = innerDict
        End If
        innerDict(row.Cells(1, 2).Value) = 1 'an arbitrary value
    Next
    Me.ComboBox1.List = dict.Keys
End Sub

---

两个依赖组合框的完整代码

请注意，重复代码已（大部分）重构为两种方法：FindOrNew 和 HandleComboboxChange。

Option Explicit

Dim dict As New Dictionary

Private Function FindOrNew(d As Dictionary, key As String) As Dictionary
    If d.Exists(key) Then
        Set FindOrNew = d(key)
    Else
        Set FindOrNew = New Dictionary
        Set d(key) = FindOrNew
    End If
End Function

Private Sub HandleComboboxChange(source As ComboBox, target As ComboBox)
    If source.Value Is Nothing Then
        Set target.list = Nothing
        Exit Sub
    End If
    Set target.Value = Nothing
End Sub

Private Sub ComboBox1_Change()
    HandleComboboxChange ComboBox1, ComboBox2
    ComboBox2.list = dict(ComboBox1.Value).Keys
End Sub

Private Sub ComboBox2_Change()
    HandleComboboxChange ComboBox2, ComboBox3
    ComboBox3.list = dict(ComboBox1.Value)(ComboBox2.Value).Keys
End Sub

Private Sub UserForm_Initialize()
    For Each row In ActiveSheet.Range("A1", "C9").rows
        Dim caseKey As String
        caseKey = row.Cells(1, 1).Value
        Dim itemKey As String
        itemKey = rows.Cells(1, 2).Value

        Dim dictLevel2 As Dictionary
        Set dictLevel2 = FindOrNew(dict, caseKey)
        Dim innerDict As Dictionary
        Set innerDict = FindOrNew(dictLevel2, itemKey)

        innerDict(row.Cells(1, 3).Value) = 1 'an arbitrary value
    Next
    ComboBox1.list = dict.Keys
End Sub