在VBA中按键sorting字典

我已经在VBA中使用CreateObject("Scripting.Dictionary")创build了一个字典，它将源词映射到目标词，在某些文本中被replace（这实际上是用于混淆）。

不幸的是，当我根据下面的代码进行实际replace时，它将按照它们被添加到字典中的顺序来replace源语言。 如果我有例如“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 

我想我可以解决这个问题，首先从最长的字典的键到最短的长度，然后按照上面的方式进行replace。 问题是我不知道如何用这种方法对键进行sorting。

Answer 1

这看起来像我自己想出来的。 我创build了以下function，似乎是做这个工作：

 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

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

我对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