11

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

最初に辞書のキーを最長から最短の長さに並べ替えてから、上記のように置換することで、この問題を解決できると考えています。問題は、この方法でキーを並べ替える方法がわからないことです。

4

5 に答える 5

15

自分で思いついたようです。仕事をしているように見える次の関数を作成しました。

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

静的配列の詳細については、https ://excelmacromastery.com/excel-vba-array/#Declaring_an_Array を参照してください。

于 2013-02-11T08:39:57.827 に答える
5

Microsoft Excel でキー値の昇順で辞書を並べ替える単純な VBA 関数を探していました。

目的に合わせて 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
于 2014-11-24T15:22:47.457 に答える