在VBA中按键排序字典

问题描述

我已经使用 CreateObject（Scripting.Dictionary）在VBA中创建了一个字典，它将源字词映射到某些文本中要替换的目标字（这实际上是为objuscation）。

不幸的是，当我按照下面的代码进行实际替换时，它将按照添加到字典的顺序替换源词。如果我以蓝色，然后是蓝莓，蓝莓中的蓝色部分被第一个目标替代，Berry仍然是这样。

 '这是我替换值
对于每个curKey在dctRepl.keys（）
 largeTxt =替换（largeTxt，curKey，dctRepl（ curKey））
下一个
  

我想我可以先解决这个问题字典的键从最长的长度到最短的长度，然后如上所述进行替换。问题是我不知道如何按这种方式排序密钥。

解决方案

看起来我自己想出来了。我创建了以下功能，似乎正在做这个工作：

 公共函数funcSortKeysByLengthDesc（dctList As Object）As Object 
 Dim arrTemp（）As String 
 Dim curKey As Variant 
 Dim itX As Integer 
 Dim itY As Integer 
 
'只有在dict中有多个项目才能排序
如果dctList.Count> 1然后
 
'填充数组
 ReDim arrTemp（dctList.Count）
 itX = 0 
对于每个curKey在dctList 
 arrTemp（itX）= curcey 
 itX = itX + 1 
下一个
 
'在数组中执行排序
对于itX = 0 To（dctList.Count  -  2）
对于itY =（itX + 1）To（dctList.Count  -  1）
如果Len（arrTemp（itX））< Len（arrTemp（itY））然后
 curKey = arrTemp（itY）
 arrTemp（itY）= arrTemp（itX）
 arrTemp（itX）= curKey 
 End If 
下一个
下一个
 
'创建新字典
设置funcSortKeysByLengthDesc = CreateObject（Scripting.Dictionary）
对于itX = 0 To（dctList.Count  -  1 ）
 funcSortKeysByLengthDesc.Add arrTemp（itX），dctList（arrTemp（itX））
下一个
 
 Else 
设置funcSortKeysByLengthDesc = dctList 
 End If 
结束功能
  

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).

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.

'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 keys from 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.

解决方案

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)
        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

这篇关于在VBA中按键排序字典的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！