VBAのキーによる辞書の並べ替え

Question

CreateObject("Scripting.Dictionary")を使用してVBAで辞書を作成しました。この辞書では、元の単語を一部のテキストで置換する対象の単語にマッピングしています（これは難読化用です）。

残念ながら、私は以下のコードに従って実際の置換を行うと、辞書に追加された順序でソースワードを置き換えます。それから私が "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

私はそれを自分で見つけたようです。私は、Microsoft Excelでキーの値を昇順に辞書をソートする簡単なVBA関数を探していました

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