字典里面的字典

我发现一个旧的方法http://www.techbookreport.com/tutorials/vba_dictionary2.html在VBA中的字典中执行字典，但在Scripting库中的Excel 2013中修改，我不能使嵌套的工作方式相同。

或者在那里？

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 

Answer 2

字典词典：

---

迟绑定慢 ： CreateObject（“Scripting.Dictionary”）

早期绑定是快速的 ：VBA编辑器 – > 工具 – > 引用 – >添加Microsoft脚本运行时

---

 Option Explicit Public Sub nestedList() Dim ws As Worksheet, i As Long, j As Long, x As Variant, y As Variant, z As Variant Dim itms As Dictionary, subItms As Dictionary 'ref to "Microsoft Scripting Runtime" Set ws = Worksheets("Sheet1") Set itms = New Dictionary For i = 2 To ws.UsedRange.Rows.Count Set subItms = New Dictionary '<-- this should pick up a new dictionary For j = 2 To ws.UsedRange.Columns.Count ' Key: "Property 1", Item: "A" subItms.Add Key:=ws.Cells(1, j).Value2, Item:=ws.Cells(i, j).Value2 Next ' Key: "Item 1", Item: subItms itms.Add Key:=ws.Cells(i, 1).Value2, Item:=subItms Set subItms = Nothing '<-- releasing previous object Next MsgBox "Row 5, Column 4: ---> " & itms("Row 5")("Column 4") End Sub 

---