2013-02-11 54 views
6

में कुंजी द्वारा एक शब्दकोश को सॉर्ट करना मैंने CreateObject("Scripting.Dictionary") का उपयोग करके वीबीए में एक शब्दकोश बनाया है जो कुछ पाठों में शब्दों को बदलने के लिए स्रोत शब्दों को मानचित्रित करता है (यह वास्तव में obfuscation के लिए है)।वीबीए

दुर्भाग्य से, जब मैं नीचे दिए गए कोड के अनुसार वास्तविक प्रतिस्थापन करता हूं, तो यह स्रोत शब्दों को उस क्रम में बदल देगा जो उन्हें शब्दकोश में जोड़ा गया था। यदि मेरे पास उदाहरण के लिए "ब्लू" और फिर "ब्लू बेरी" है, तो "ब्लू बेरी" में "ब्लू" भाग को पहले लक्ष्य से बदल दिया गया है और "बेरी" जैसा ही था।

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

मुझे लगता है कि मैं पहली बार सबसे लंबे समय तक लंबाई से शब्दकोश का कुंजी छँटाई लंबाई कम से कम करने के लिए और फिर कर के रूप में ऊपर की जगह द्वारा इस समस्या को हल कर सकता है सोच रहा हूँ। समस्या यह है कि मुझे नहीं पता कि चाबियाँ कैसे इस तरह सॉर्ट करें।

+2

सी [cpearson.com] (http://www.cpearson.com:

मैं अपने उद्देश्य के अनुरूप करने के (परिवर्तन की जानकारी के लिए निम्नलिखित '// टिप्पणी देखें) neelsg के कोड में कुछ मामूली परिवर्तन किए /excel/CollectionsAndDories.htm) –

+1

@chrisneilsen: अच्छा लिंक हालांकि मुझे बिल्कुल वही नहीं चाहिए। – neelsg

उत्तर

8

ऐसा लगता है कि मैंने इसे स्वयं समझ लिया।

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 
2

मैं Microsoft Excel में महत्वपूर्ण मूल्य आरोही द्वारा शब्दकोशों सॉर्ट करने के लिए एक सरल VBA समारोह लिए देख रहा था: मैं निम्नलिखित समारोह काम कर प्रतीत होता है कि बनाया।

'/* 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 
+1

"डिफ" टिप्पणी करने के बजाय पूर्ण स्वच्छ कोड के साथ पढ़ने के लिए बहुत आसान होगा – Askolein