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

Question

我需要在字典中的特定键和项目对之后添加项目。基本上与添加成员在集合中允许的行为相同： （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 

，并测试其运行下面的过程：

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 

这只是让你开始如果我是这样做的。我自己我可能会创建我自己的自定义类使用和创建一个自定义添加方法而不是使用函数。我还做了如下改进：

• 加入错误处理
• 使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

BEFORE

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

AFTER

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

Answer 3

代替排序的字典时，我t包含了我实现的所有项目，称为DctAdd的一个小程序，它可以在添加项目时立即对键进行排序。 假设关键字是vAdd，该项目是vItem，类型变体和要排序的字典都是dct。因此，而不是：

dct.Add vAdd, vItem 

我用：

DctAdd dct, vItem, vAdd, dam_sortasc 

因为我只包括一些基本的测试，因为我发现它足以在我的项目使用时的性能。

要使用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, warbe@cogip.de, 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 

这我用来测试：

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