Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

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.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
972 views
Welcome To Ask or Share your Answers For Others

1 Answer

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

For more info on static arrays see: https://excelmacromastery.com/excel-vba-array/#Declaring_an_Array


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...