在 VBA 中按键对字典进行排序

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/14808104/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 14:56:12  来源:igfitidea点击:

Sorting a dictionary by key in VBA

excelvbaexcel-vbadictionary

提问by neelsg

I have created a dictionary in VBA using CreateObject("Scripting.Dictionary")that maps source words to target words to be replaced in some text (This is actually for obfuscation).

我在 VBA 中创建了一个字典,使用CreateObject("Scripting.Dictionary")它将源词映射到要在某些文本中替换的目标词(这实际上是为了混淆)。

Unfortunately, when I do the actual replace as per the code below, it will replace the source words in the order they were added to the dictionary. If I then have for instance "Blue" and then "Blue Berry", the "Blue" part in "Blue Berry" is replaced by the first target and " Berry" remains as it was.

不幸的是,当我按照下面的代码进行实际替换时,它将按照源词添加到字典中的顺序替换它们。如果我有例如“Blue”和“Blue Berry”,“Blue Berry”中的“Blue”部分被第一个目标替换,而“Berry”保持原样。

'This is where I replace the values
For Each curKey In dctRepl.keys()
    largeTxt = Replace(largeTxt, curKey, dctRepl(curKey))
Next

I'm thinking that I could resolve this issue by first sorting the dictionary's keysfrom longest length to shortest length and then doing the replace as above. The problem is I don't know how to sort the keys this way.

我想我可以通过首先将字典的从最长长度到最短长度排序,然后按上述方式进行替换来解决这个问题。问题是我不知道如何以这种方式对键进行排序。

回答by neelsg

It looks like I figured it out myself. I created the following function that appears to be doing the job:

看来我自己想通了。我创建了以下似乎正在完成这项工作的函数:

Public Function funcSortKeysByLengthDesc(dctList As Object) As Object
    Dim arrTemp() As String
    Dim curKey As Variant
    Dim itX As Integer
    Dim itY As Integer

    'Only sort if more than one item in the dict
    If dctList.Count > 1 Then

        'Populate the array
        ReDim arrTemp(dctList.Count - 1)
        itX = 0
        For Each curKey In dctList
            arrTemp(itX) = curKey
            itX = itX + 1
        Next

        'Do the sort in the array
        For itX = 0 To (dctList.Count - 2)
            For itY = (itX + 1) To (dctList.Count - 1)
                If Len(arrTemp(itX)) < Len(arrTemp(itY)) Then
                    curKey = arrTemp(itY)
                    arrTemp(itY) = arrTemp(itX)
                    arrTemp(itX) = curKey
                End If
            Next
        Next

        'Create the new dictionary
        Set funcSortKeysByLengthDesc = CreateObject("Scripting.Dictionary")
        For itX = 0 To (dctList.Count - 1)
            funcSortKeysByLengthDesc.Add arrTemp(itX), dctList(arrTemp(itX))
        Next

    Else
        Set funcSortKeysByLengthDesc = dctList
    End If
End Function

For more info on static arrays see: https://excelmacromastery.com/excel-vba-array/#Declaring_an_Array

有关静态数组的更多信息,请参见:https: //excelmacromastery.com/excel-vba-array/#Declaring_an_Array

回答by mvanle

I was looking for a simple VBA function to sort dictionaries by ascending key value in Microsoft Excel.

我正在寻找一个简单的 VBA 函数来通过在 Microsoft Excel 中按升序键值对字典进行排序。

I made some minor changes to neelsg's code to suit my purpose (see the following '//comments for details of changes):

我对 neelsg 的代码做了一些小改动以满足我的目的('//有关更改的详细信息,请参阅以下评论):

'/* Wrapper (accurate function name) */
Public Function funcSortDictByKeyAscending(dctList As Object) As Object
    Set funcSortDictByKeyAscending = funcSortKeysByLengthDesc(dctList)
End Function

'/* neelsg's code (modified) */
Public Function funcSortKeysByLengthDesc(dctList As Object) As Object
'//    Dim arrTemp() As String
    Dim arrTemp() As Variant
...
...
...
        'Do the sort in the array
        For itX = 0 To (dctList.Count - 2)
            For itY = (itX + 1) To (dctList.Count - 1)
'//                If Len(arrTemp(itX)) < Len(arrTemp(itY)) Then
                If arrTemp(itX) > arrTemp(itY) Then
...
...
...
        'Create the new dictionary
'//        Set funcSortKeysByLengthDesc = CreateObject("Scripting.Dictionary")
        Set d = CreateObject("Scripting.Dictionary")
        For itX = 0 To (dctList.Count - 1)
'//            funcSortKeysByLengthDesc.Add arrTemp(itX), dctList(arrTemp(itX))
            d(arrTemp(itX)) = dctList(arrTemp(itX))
        Next
'// Added:
        Set funcSortKeysByLengthDesc = d
    Else
        Set funcSortKeysByLengthDesc = dctList
    End If
End Function