在Excel中使用VBA将项目添加到词典中的特定位置

我需要在字典中的特定键和项目对之后添加项目。 基本上与添加成员允许在集合中相同的行为：（ Collection.Add (item [,key] [,before] [,after])

Answer 1

Dictionary对象没有允许的内置方法。 这是一个快速的方法来推出自己的。 这将具体实现你所要求的，但修改应该很简单：

 Function DictAdd(StartingDict As Dictionary, Key, Item, AfterKey) As Dictionary Dim DictKey As Variant Set DictAdd = New Dictionary For Each DictKey In StartingDict DictAdd.Add DictKey, StartingDict(DictKey) If DictKey = AfterKey Then DictAdd.Add Key, Item Next DictKey End Function 

并testing它运行以下过程：

 Sub TestDictAdd() Dim MyDict As New Dictionary, DictKey As Variant MyDict.Add "A", "Alpha" MyDict.Add "C", "Charlie" Set MyDict = DictAdd(MyDict, "B", "Bravo", "A") For Each DictKey In MyDict Debug.Print DictKey, MyDict(DictKey) Next DictKey End Sub 

这只是为了让你开始。 如果我为自己做这个，我可能会创build自己的自定义类来使用，并创build一个自定义的添加方法，而不是使用一个函数。 我也做了以下改进：

• 添加error handling
• 使AfterKey成为可选参数
• 添加BeforeKey作为可选参数

Answer 2

喜欢这个？

 Option Explicit Sub Sample() Dim Dict As Dictionary Dim itm As Variant Set Dict = New Dictionary Dict.Add "MyKey1", "Hello" Dict.Add "MyKey2", "This" Dict.Add "MyKey3", "is" Dict.Add "MyKey4", "Example" '~~> USAGE: Dictionaty Object, Key, Text, Position Additem Dict, "MyKey5", "An", 3 For Each itm In Dict Debug.Print itm & " - " & Dict(itm) Next End Sub Function Additem(ByRef D As Dictionary, ky As Variant, itm As Variant, pos As Long) Dim kyAr() As Variant, itmAr() As Variant Dim temp1() As Variant, temp2() As Variant Dim i As Long kyAr = D.Keys: itmAr = D.Items ReDim temp1(UBound(kyAr) + 1) ReDim temp2(UBound(itmAr) + 1) For i = 0 To pos - 1 temp1(i) = kyAr(i): temp2(i) = itmAr(i) Next temp1(pos) = ky: temp2(pos) = itm For i = pos + 1 To UBound(temp1) temp1(i) = kyAr(i - 1): temp2(i) = itmAr(i - 1) Next ReDim kyAr(0): ReDim itmAr(0) kyAr() = temp1(): itmAr() = temp2() D.RemoveAll For i = LBound(kyAr) To UBound(kyAr) D.Add kyAr(i), itmAr(i) Next i End Function 

OUTPUT

之前

 MyKey1 - Hello MyKey2 - This MyKey3 - is MyKey4 - Example 

后

 MyKey1 - Hello MyKey2 - This MyKey3 - is MyKey5 - An MyKey4 - Example 

Answer 3

当它包含所有项目时，我并没有对字典进行sorting，而是实现了一个名为DctAdd的小程序，它可以在添加项目时立即对键值进行sorting。 假设密钥是vAdd，则该项目是vItem，types变体和已经sorting的字典是dct。 所以，而不是：

 dct.Add vAdd, vItem 

我用：

 DctAdd dct, vItem, vAdd, dam_sortasc 

对于演出，我只包括一些基本的testing，因为我发现在我的项目中使用它足够了。

要使用DctAdd，必须将以下内容复制到相关模块的声明部分：

 ' Just for the performance time measurement ----------------------------- Private Declare Function GetTime Lib "winmm.dll" Alias "timeGetTime" () As Long ' For the execution mode of DctAdd -------------------------------------- ' (may be extended to also cover insert before and after) Public Enum enAddInsertMode dam_sortasc = 1 dam_sortdesc = 2 End Enum 

下面的代码可以复制到任何标准或类模块：请注意，插入之前/之后还没有实现，但不应该花很长时间来添加。

 Public Sub DctAdd(ByRef dct As Scripting.Dictionary, _ ByVal vItem As Variant, _ ByVal vAdd As Variant, _ ByVal lMode As enAddInsertMode) ' ---------------------------------------------------------------------- ' Add to the Dictionary dct the item vItem with vAdd as the key, ' sorted in ascending or descending order. ' ' If the vAdd key already exists, adding it will be skipped without ' an error. A not existing dictionary is established with the first add ' ' W. Rauschenberger, [e-mail], Berlin, Feb 2015 ' ---------------------------------------------------------------------- Dim i As Long Dim dctTemp As Scripting.Dictionary Dim vTempKey As Variant Dim bAdd As Boolean If dct Is Nothing Then Set dct = New Dictionary With dct If .count = 0 Then .Add vAdd, vItem Exit Sub Else ' ----------------------------------------------------------- ' The can maybee added directly after the last key ' ----------------------------------------------------------- vTempKey = .Keys()(.count - 1) ' Get the very last key Select Case lMode Case dam_sortasc If vAdd > vTempKey Then .Add vAdd, vItem Exit Sub ' Done! End If Case dam_sortdesc If vAdd < vTempKey Then .Add vAdd, vItem Exit Sub ' Done! End If End Select End If End With ' ----------------------------------------------------------------- ' Since the new key could not simply be added to the dct it must be ' added/inserted somewhere in between or before the very first key ' ------------------------------------------------------------------ Set dctTemp = New Dictionary bAdd = True For Each vTempKey In dct With dctTemp If bAdd Then ' When the new item has yet not been added Select Case lMode Case dam_sortasc If vTempKey > vAdd Then If Not dct.Exists(vAdd) Then .Add vAdd, vItem End If bAdd = False ' Add done End If Case dam_sortdesc If vTempKey < vAdd Then If Not dct.Exists(vAdd) Then .Add vAdd, vItem End If bAdd = False ' Add done End If End Select End If .Add vTempKey, dct.Item(vTempKey) End With Next vTempKey ' ------------------------------------ Set dct = dctTemp ' Return the temporary dictionary with Set dctTemp = Nothing ' the added new item Exit Sub ' ------------------------------------ on_error: Debug.Print "Error in 'DctAdd'!" End Sub 

这个我用来testing：

 Public Sub Testdct1Add() Dim dct1 As Scripting.Dictionary Dim dct2 As Scripting.Dictionary Dim i As Long Dim lStart As Long Dim lAdd As Long Dim vKey As Variant ' ----------------------------------------------------------------------- Debug.Print vbLf & "DctAdd: Test ascending order" ' Add sorted ascending with the key provided in the reverse order Set dct1 = Nothing For i = 10 To 1 Step -1 DctAdd dct1, i, i, dam_sortasc Next i ' Show the result and wait ---------------- For Each vKey In dct1 Debug.Print vKey & " " & dct1.Item(vKey) Next vKey Stop ' ------------------------------------------------------------------ Debug.Print vbLf & "DctAdd: Test descending order" ' Add sorted ascending with the key provided in the reverse order Set dct1 = Nothing For i = 1 To 10 DctAdd dct1, i, i, dam_sortdesc Next i ' Show the result and wait ---------------- For Each vKey In dct1 Debug.Print vKey & " " & dct1.Item(vKey) Next vKey Stop ' ------------------------------------------------------------------ lAdd = 500 Debug.Print vbLf & "DctAdd: Test a best case scenario by adding " & _ vbLf & lAdd & " items in the desired sort order" Set dct1 = Nothing lStart = GetTime For i = 1 To lAdd DctAdd dct1, i, i, dam_sortasc Next i Debug.Print "Adding " & dct1.count & " items in the target " & _ vbLf & "sort order = " & GetTime - lStart & " ms" Stop ' ------------------------------------------------------------------ lAdd = 500 Debug.Print vbLf & "DctAdd: Worst case scenarion test by adding " & _ vbLf & lAdd & " items in the reverse sort order" Set dct1 = Nothing lStart = GetTime For i = lAdd To 1 Step -1 DctAdd dct1, i, i, dam_sortasc Next i Debug.Print "Adding " & dct1.count & " items, 4 out of " & vbLf & _ "order = " & GetTime - lStart & " ms" Stop ' ----------------------------------------------------------------- lAdd = 1000 Debug.Print vbLf & "DctAdd: Worst case scenarion test by adding " & _ vbLf & lAdd & " items in the reverse sort order" Set dct1 = Nothing lStart = GetTime For i = lAdd To 1 Step -1 DctAdd dct1, i, i, dam_sortasc Next i Debug.Print "Adding " & dct1.count & " items:" & vbLf & _ GetTime - lStart & " ms" Stop ' ----------------------------------------------------------------- ' Example for using dctAdd to sort any dictionary. The item if dct2 ' are temporarily added sorted ascending to the dct1 and finally set ' to dct2 ' ------------------------------------------------------------------ Debug.Print vbLf & "DctAdd: Used to sort another Dictionary (dct2)" Set dct2 = New Dictionary dct2.Add "F", 1 dct2.Add "A", 2 dct2.Add "C", 3 dct2.Add "H", 4 dct2.Add "D", 5 dct2.Add "E", 6 dct2.Add "G", 7 dct2.Add "B", 8 Set dct1 = Nothing For Each vKey In dct2 DctAdd dct1, dct2(vKey), vKey, dam_sortasc Next vKey Set dct2 = dct1 ' Show the result and wait ---------------- For Each vKey In dct2 Debug.Print "Key=" & vKey & ", Item=" & dct2.Item(vKey) Next vKey End Sub