很明显，会有一个循环这里是许多暂定词之一(但是，正如我所说，我对字典的了解真的很差)Dim d As Variant, dict As ObjectDim v As Long, a As VariantDim vCount As LongDim vCount1 As LongSet dict = CreateObject("Scripting.Dictionary")dict.CompareMode = vbTextCompare 'default is vbbinarycompare With Sheets("Sheet1") '<- alter to suitea = .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 vMe.ComboBox1.List = dict.KeysMe.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 vEnd With如果有第三列怎么办?例子Column A Column B Column CCase 1 Item ACase 1 Item B number 1Case 1 Item A number 1Case 2 Item C number 2Case 2 Item C number 1Case 3 Item D number 3Case 3 Item E number 1Case 3 Item F number 1Case 3 Item D number 2结果应该是Case 1 Item A number1 Item B number1Case 2 Item C number1 number2Case 3 Item D number2 number3 Item E number1 Item F number1在这里，我尝试根据Zev Spitz的建议构建代码，但没有成功Dim row As VariantDim dict As New DictionaryFor Each row In Sheets("Positioning").Range("h2", Range("p" &Rows.Count).End(xlUp)).RowsDim caseKey As StringcaseKey = row.Cells.Item(2, 1).ValueDim innerDict As Scripting.DictionaryIf dict.Exists(caseKey) Then Set innerDict = dict(caseKey)Else Set innerDict = New Scripting.Dictionary Set dict(caseKey) = innerDictEnd IfinnerDict(row.Cells.Item(2, 3).Value) = 1Dim outerKey As Variant, innerKey As Variant, inner2Key As Variant Dim inner2Dict As Scripting.DictionaryFor Each innerKey In innerDict.KeysSet inner2Dict = New Scripting.DictionaryIf inner2Dict.Exists(inner2Dict) ThenSet innerDict(innerKey) = inner2DictElseSet inner2Dict = inner2DictEnd Ifinner2Dict(row.Cells.Item(2, 8).Value) = 1NextNextFor Each outerKey In dict.KeysDebug.Print outerKey For Each innerKey In innerDict.Keys Debug.Print vbTab, innerKey For Each inner2Key In inner2Dict.Keys Debug.Print vbTab, vbTab, inner2Key Next NextNext解决方案 使用嵌套字典加载数据您可以使用具有其他字典作为其值的字典:Dim row As VariantDim dict As New DictionaryFor 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 valueNext然后，您可以遍历外部词典中的每个键，并遍历内部词典中的每个键.例如，以下代码:Dim outerKey As Variant, innerKey As VariantFor Each outerKey In dict.Keys Debug.Print outerKey For Each innerKey In dict(outerKey).Keys Debug.Print vbTab, innerKey NextNext将输出以下内容:Case 1 Item A Item BCase 2 Item CCase 3 Item D Item E Item F有关如何使用字典获取唯一值集的说明，请参见此处. >根据第一个组合框中的选择填充另一个组合框假设您已将第一个组合框的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).KeysEnd Sub使用SQL的唯一值获取值的唯一组合的另一种方法可能是在Excel工作表上执行SQL语句:SELECT DISTINCT [Column A], [Column B]FROM [Sheet1$]但这通常以ADO或DAO平面记录集(带有字段和行)的形式返回，而嵌套字典保留了此数据的层次性质.完成代码隐藏添加对 Microsoft脚本运行时的引用(工具> 参考... )Option ExplicitDim dict As New DictionaryPrivate 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).KeysEnd SubPrivate 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.KeysEnd Sub后面两个完整的组合框的完整代码请注意，重复代码(大部分)已重构为两种方法:FindOrNew和HandleComboboxChange.Option ExplicitDim dict As New DictionaryPrivate 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 IfEnd FunctionPrivate 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 = NothingEnd SubPrivate Sub ComboBox1_Change() HandleComboboxChange ComboBox1, ComboBox2 ComboBox2.list = dict(ComboBox1.Value).KeysEnd SubPrivate Sub ComboBox2_Change() HandleComboboxChange ComboBox2, ComboBox3 ComboBox3.list = dict(ComboBox1.Value)(ComboBox2.Value).KeysEnd SubPrivate 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.KeysEnd SubI’d like to know which is the quickest way to get the unique values from a column and then the unique values in another column for each of the values previously found in the first columnExampleColumn A Column BCase 1 Item ACase 1 Item BCase 1 Item ACase 2 Item CCase 2 Item CCase 3 Item DCase 3 Item ECase 3 Item FCase 3 Item DThe result should return three values from the first column (Case 1, Case 2, Case 3) and then two values for Case 1 (Item A and Item B), one value for Case 2 (Item C), three values for Case 3 (Item D, Item E, Item F)I do not want to use an advance filter or copy filtered rows in another sheet.I tried to reach that using scripting dictionary, but I don’t know dictionary so well, and I was not able to use the keys of the first dictionary (Case 1, …) as parameters to add the items in the second dictionary (Item A, ….)Ideally, at the end, the macro will create one textbox for each key of the first dictionary and then for each of those creates other text boxes for each key of the second dictionary (I kind of treeview but using textboxes)Clearly, there will be a loopHere one of the many tentatives (but, as I said, I have really poor knowledge in dictionary)Dim d As Variant, dict As ObjectDim v As Long, a As VariantDim vCount As LongDim vCount1 As LongSet dict = CreateObject("Scripting.Dictionary")dict.CompareMode = vbTextCompare 'default is vbbinarycompare With Sheets("Sheet1") '<- alter to suitea = .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 vMe.ComboBox1.List = dict.KeysMe.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 vEnd WithWhat if there is a third column ?ExampleColumn A Column B Column CCase 1 Item ACase 1 Item B number 1Case 1 Item A number 1Case 2 Item C number 2Case 2 Item C number 1Case 3 Item D number 3Case 3 Item E number 1Case 3 Item F number 1Case 3 Item D number 2the result should beCase 1 Item A number1 Item B number1Case 2 Item C number1 number2Case 3 Item D number2 number3 Item E number1 Item F number1here the code I tried to build based on Zev Spitz suggestion, but without successDim row As VariantDim dict As New DictionaryFor Each row In Sheets("Positioning").Range("h2", Range("p" &Rows.Count).End(xlUp)).RowsDim caseKey As StringcaseKey = row.Cells.Item(2, 1).ValueDim innerDict As Scripting.DictionaryIf dict.Exists(caseKey) Then Set innerDict = dict(caseKey)Else Set innerDict = New Scripting.Dictionary Set dict(caseKey) = innerDictEnd IfinnerDict(row.Cells.Item(2, 3).Value) = 1Dim outerKey As Variant, innerKey As Variant, inner2Key As Variant Dim inner2Dict As Scripting.DictionaryFor Each innerKey In innerDict.KeysSet inner2Dict = New Scripting.DictionaryIf inner2Dict.Exists(inner2Dict) ThenSet innerDict(innerKey) = inner2DictElseSet inner2Dict = inner2DictEnd Ifinner2Dict(row.Cells.Item(2, 8).Value) = 1NextNextFor Each outerKey In dict.KeysDebug.Print outerKey For Each innerKey In innerDict.Keys Debug.Print vbTab, innerKey For Each inner2Key In inner2Dict.Keys Debug.Print vbTab, vbTab, inner2Key Next NextNext 解决方案 Loading the data using nested dictionariesYou can use a dictionary which has other dictionaries as its' values:Dim row As VariantDim dict As New DictionaryFor 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 valueNextThen you can iterate over each key in the outer dictionary, and iterate over each key in the inner dictionary. The following code, for example:Dim outerKey As Variant, innerKey As VariantFor Each outerKey In dict.Keys Debug.Print outerKey For Each innerKey In dict(outerKey).Keys Debug.Print vbTab, innerKey NextNextwill output the following:Case 1 Item A Item BCase 2 Item CCase 3 Item D Item E Item FFor an description of how to use a dictionary to get a unique set of values, see here.Populating another combobox based on the selection in the first comboboxAssuming you've set the List property of the first combobox to the Keys collection of the dictionary:Me.ComboBox1.List = dict.Keysyou can handle the Change event of the combobox, and use it to fill the second combobox with the keys of the corresponding inner 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).KeysEnd SubUnique values using SQLAnother way to get the unique combinations of values might be to execute an SQL statement on the Excel worksheet:SELECT DISTINCT [Column A], [Column B]FROM [Sheet1$]but this generally comes back as an ADO or DAO flat Recordset -- with fields and rows -- while nested dictionaries preserve the hierarchical nature of this data.Complete code-behindAdd a reference to the Microsoft Scripting Runtime (Tools > References...)Option ExplicitDim dict As New DictionaryPrivate 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).KeysEnd SubPrivate 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.KeysEnd SubComplete code behind for two dependent comboboxesNotice that the repetitious code has been (mostly) refactored into two methods: FindOrNew and HandleComboboxChange.Option ExplicitDim dict As New DictionaryPrivate 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 IfEnd FunctionPrivate 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 = NothingEnd SubPrivate Sub ComboBox1_Change() HandleComboboxChange ComboBox1, ComboBox2 ComboBox2.list = dict(ComboBox1.Value).KeysEnd SubPrivate Sub ComboBox2_Change() HandleComboboxChange ComboBox2, ComboBox3 ComboBox3.list = dict(ComboBox1.Value)(ComboBox2.Value).KeysEnd SubPrivate 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.KeysEnd Sub 这篇关于依赖字典Excel VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！
