用VBA中的鍵對字典排序

Question

我在VBA中使用CreateObject("Scripting.Dictionary")創建了一個詞典，它將源詞語與目標詞語進行映射，以便在某些文本中進行替換（這實際上是用於混淆處理）。

不幸的是，當我根據下面的代碼進行實際替換時，它將按照它們添加到字典中的順序來替換源單詞。如果我有例如「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 

我在想，我可以首先從最長長度排序字典的鍵以最短的長度，然後做替換如上解決此問題。問題是我不知道如何通過這種方式對鍵進行排序。

Answer 1

它看起來像我自己想出來的。我創建了一個似乎是做這項工作有以下功能：我一直在尋找一個簡單的VBA函數在Microsoft Excel中上升鍵值字典排序

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 

Answer 2

。

我做出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