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

Add Item to Specific Location in Dictionary with VBA in Excel

提问by Ehudz

I need to add an item after a specific key and item pair in a dictionary. Essentially the same behavior which the add member allows for in a collection: (Collection.Add (item [,key] [,before] [,after])

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

回答by mwolfe02

There is no built-in method of the Dictionary object that allows this. Here is a quick way to roll your own. This will accomplish specifically what you are asking for but it should be simple to modify:

没有允许这样做的 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

And to test it run the following procedure:

要测试它，请运行以下程序：

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

This is just to get you started. If I were doing this for myself I would probably create my own custom classto use and create a custom Add methodinstead of using a function. I'd also make the following improvements:

这只是让你开始。如果我为自己这样做，我可能会创建自己的自定义类来使用并创建自定义 Add 方法而不是使用函数。我还将进行以下改进：

• add error handling
• make AfterKey an optional parameter
• add BeforeKey as an optional parameter

• 添加错误处理
• 使 AfterKey 成为可选参数
• 添加 BeforeKey 作为可选参数

回答by Siddharth Rout

Like this?

像这样？

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

回答by Walter Rauschenberger

Instead of sorting the dictionary when it contains all items I implemented a little procedure called DctAdd which keeps the keys sorted immediately when adding an item. Assuming the key is vAdd, the item is vItem, both of type variant and the Dictionary to have sorted is dct. So instead of :

当字典包含所有项目时，我没有对字典进行排序，而是实现了一个名为 DctAdd 的小程序，它在添加项目时立即对键进行排序。假设key是vAdd，item是vItem，类型variant和要排序的Dictionary都是dct。所以而不是：

dct.Add vAdd, vItem

I use:

我用：

DctAdd dct, vItem, vAdd, dam_sortasc 

For the performance I included only some basic test since I found it sufficient when using it in my project.

对于性能，我只包含了一些基本测试，因为我发现在我的项目中使用它时已经足够了。

To use DctAdd the following has to be copied to the declaration section of the concerned module:

要使用 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

The following code can be copied to any standard or class module: Please note that insert before/after has yet not been implemented but should not take very long to add.

以下代码可以复制到任何标准或类模块中： 请注意，insert before/after 尚未实现，但不应花很长时间添加。

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, [email protected], 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

And this I used for 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