字典中的字典

Question

我在VBA中找到了一种旧方法dictionary2.html在字典中执行字典，但是在脚本库中的Excel2013修改中，我不能让嵌套以同样的方式工作。

还是真的有？

Sub dict()

Dim ws1 As Worksheet: Set ws1 = Sheets("BM")
Dim family_dict As New Scripting.Dictionary
Dim bm_dict As New Scripting.Dictionary
Dim family As String, bm As String
Dim i

Dim ws1_range As Range
Dim rng1 As Range

With ws1

    Set ws1_range = .Range(Cells(2, 1).Address & ":" & Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1).Address)

End With


For Each rng1 In ws1_range
    family = ws1.Cells(rng1.Row, 1)
    bm = ws1.Cells(rng1.Row, 2)

    If family_dict.Exists(family) Then
        Set bm_dict = family_dict(family)("scripting.dictionary")

        If bm_dict.Exists(bm) Then
        Else
            bm_dict.Add bm, Empty
        End If
    Else
        family_dict.Add family, Empty
        Set bm_dict = family_dict(family)("scripting.dictionary")

        If bm_dict.Exists(bm) Then
        Else
            bm_dict.Add bm, Empty
        End If
    End If
        For Each i In family_dict.Keys: Debug.Print i: Next
        For Each i In bm_dict.Keys: Debug.Print i: Next
        For Each i In bm_dict.Items: Debug.Print i: Next
        Debug.Print bm_dict.Count

Next

End Sub

Answer 1

工作表的工作代码：

Sub dict()

    Dim ws1 As Worksheet: Set ws1 = Sheets("BM")
    Dim family_dict As Dictionary, bm_dict As Dictionary
    Dim i, j

    Dim ws1_range As Range
    Dim rng1 As Range, rng2 As Range

    With ws1

        Set ws1_range = .Range(Cells(2, 1).Address & ":" & Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1).Address)

    End With

    Set family_dict = New Dictionary

    For Each rng1 In ws1_range
        If Not family_dict.Exists(Key:=ws1.Cells(rng1.Row, 1).Value2) Then
            Set bm_dict = New Dictionary
            For Each rng2 In ws1_range
                    If rng2 = rng1 Then
                    If Not bm_dict.Exists(Key:=ws1.Cells(rng2.Row, 2).Value2) Then
                        bm_dict.Add Key:=ws1.Cells(rng2.Row, 2).Value2, Item:=Empty
                    End If
                End If
            Next
            family_dict.Add Key:=ws1.Cells(rng1.Row, 1).Value2, Item:=bm_dict
            Set bm_dict = Nothing
        End If
    Next
'---test---immediate window on---
            For Each i In family_dict.Keys: Debug.Print i: For Each j In family_dict(i): Debug.Print j: Next: Next
End Sub