Сортировка словаря по ключу в VBA

Я создал словарь в VBA, используя CreateObject("Scripting.Dictionary") это сопоставляет исходные слова с целевыми словами, которые должны быть заменены в некотором тексте (это на самом деле для обфускации).

к сожалению, когда я делаю фактическую замену в соответствии с приведенным ниже кодом, он заменит исходные слова в том порядке, в котором они были добавлены в словарь. Если у меня тогда есть, например, "синяя", а затем "синяя ягода"," синяя "часть в" синей ягоде "заменяется первой целью, и "ягода" остается такой, как она есть было.

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

Я думаю, что я мог бы решить эту проблему, первая сортировка словаря ключи от самой длинной длины к самой короткой длине и после этого делать заменить как выше. Проблема в том, что я не знаю, как сортировать ключи таким образом.

8
dictionary excel excel-vba vba

2 ответов

похоже, я сам догадался. Я создал следующую функцию, которая, похоже, выполняет эту работу:

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
10

Я искал простую функцию VBA для сортировки словарей по возрастанию значения ключа в Microsoft Excel.

я внес некоторые незначительные изменения в код нильсга в соответствии с моей целью (см. Следующее '// комментарии для деталей изменений):

'/* 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
3