मैं एक फ़ंक्शन के साथ एक शब्दकोश को सॉर्ट करने का प्रयास कर रहा हूं जो मुझे एक ऑब्जेक्ट प्रॉपर्टी द्वारा ऑनलाइन मिला है जो कि आईडी है लेकिन इस For Each i In dict लाइन पर मुझे यह त्रुटि संदेश मिल रहा है माइक्रोसॉफ्ट वीबीस्क्रिप्ट रनटाइम त्रुटि: ऑब्जेक्ट इस संपत्ति का समर्थन नहीं करता है या तरीका। मैंने For Each i In dict.Items की कोशिश की है, लेकिन मुझे 'dict.Items' के साथ वही त्रुटि संदेश मिलता है। मैं VBScript के पुराने संस्करण का उपयोग कर रहा हूं, इसलिए इसमें dict.Count जैसी सुविधाएं नहीं हैं।

वीबीस्क्रिप्ट क्लास:

Class TestClass
    Public ID
    Public TestText
    Private Sub Class_Initialize
            TestText  = ""
    End Sub
End Class

Set gDic = CreateObject("Scripting.Dictionary")


For i = 1 to 5
    Set temp = new TestClass
    temp.ID = i
    temp.TestText = "Test" & i

    gDic.Add i,temp
Next


Set NewDic = SortDict(gDic)
msgbox NewDic.Items()(1).TestText

सॉर्ट फ़ंक्शन:

Function SortDict(ByVal dict)
    Dim i, j, temp
    For Each i In dict
        For Each j In dict
            If(dict.Item(i) <= dict.Item(j)) Then
                temp = dict.Item(i)
                dict.Item(i) = dict.Item(j)
                dict.Item(j) = temp
            End If
        Next
    Next
    Set SortDict = dict
End Function
3
Decoder94 5 जिंदा 2018, 16:39

2 जवाब

@Potato द्वारा प्रदान किए गए उत्तरों को जोड़ने के लिए, मुझे एक शब्दकोश में दो मानों को अवरोही करके क्रमबद्ध करने और इन मानों की तुलना डेटाबेस से करने की आवश्यकता है। सौभाग्य से यूआई ने मुझे अवरोही द्वारा पहले क्रमबद्ध करने की अनुमति दी और फिर मैंने डीबी के मूल्यों की तुलना करने के लिए @ पोटाटो द्वारा प्रदान की गई सॉर्टिंग विधि का उपयोग किया। अगर मुझे डीबी में एक से अधिक मूल्यों को क्रमबद्ध करने की आवश्यकता होती तो मुझे और शब्दकोशों का उपयोग करना पड़ता।

यह फ़ंक्शन एक शब्दकोश को आईडी जैसे समान मानों के आधार पर एक समूह लेता है। फिर उस डिक्शनरी को ReverseSortDescDict(descDict) में दूसरे मान से सॉर्ट करें

Function OrderCompareDictionary(UICompareDict, MIPdict)
arrItems = UICompareDict.Items
arrKeys = UICompareDict.Keys
limitkeys = cint(UBound(arrKeys))
numOfCols = Ubound(arrItems(0))    
Set descDict = CreateObject("Scripting.Dictionary")

For k = 0 To limitkeys    
If Ubound(arrItems(k)) = numOfCols Then
    If not (k < 0 or k > UBound(arrKeys))  Then
        If not (k = UBound(arrKeys)) Then
            If arrItems(k)(0) = arrItems(k + 1)(0) Then 
                descDict.Add arrKeys(k) , arrItems(k)
            Else 
                descDict.Add arrKeys(k) , arrItems(k)  'Does not match next value
                Call ReverseSortDescDict(descDict)
                Call CompareAndResetDescDict(descDict, k, MIPdict)
            End If
        Else
            If arrItems(k)(0) = arrItems(k - 1)(0) Then 'Last row matches previous row
                descDict.Add arrKeys(k) , arrItems(k)
                Call ReverseSortDescDict(descDict)
                Call CompareAndResetDescDict(descDict, k, MIPdict)                    
            Else
                descDict.Add arrKeys(k) , arrItems(k)
                Call ReverseSortDescDict(descDict)
                Call CompareAndResetDescDict(descDict, k, MIPdict)                    
            End If
        End If
    Else
        MsgBox "Out of bounds for dictionary array values"
    End If
Else
    MsgBox "Error in comparison"
End If
Next      
End Function

यह फ़ंक्शन तुलना करने से पहले अवरोही द्वारा क्रमबद्ध करता है। शब्दकोश वस्तु को देखने के लिए प्रिंट स्टेटमेंट शामिल हैं।

Function ReverseSortDescDict(descDict)

Dim i, j, temp
For Each i In descDict
    For Each j In descDict
        If(descDict.Item(i)(1) >= descDict.Item(j)(1)) Then
            temp = descDict.Item(i)
            descDict.Item(i) = descDict.Item(j)
            descDict.Item(j) = temp
        End If
    Next
Next

displayDescDictCount = 0
descDictKeys = descDict.Keys
descDictItems = descDict.Items
For each item in descDictItems 
    print descDictKeys (displayDescDictCount) & " " & item(0) & " " & item(1) & " " & item(2)
    displayDescDictCount = displayDescDictCount + 1
Next

End Function 
0
William Humphries 7 मार्च 2019, 19:36

यदि आपको शब्दकोश के साथ एक ही पास करने की आवश्यकता है तो आप कुंजियों को सॉर्ट करने के लिए डिस्कनेक्ट किए गए रिकॉर्डसेट का उपयोग कर सकते हैं, फिर रिकॉर्डसेट से कुंजी प्राप्त करने के लिए शब्दकोश से मान पुनर्प्राप्त कर सकते हैं।

dim rs 'the recordset used to sort keys  must be global
Set D = CreateObject("Scripting.Dictionary") 
for i=1 to 10
d.add right("0000"&Cint(rnd*10000),4), i
next

'
for each j in d.keys
   wscript.echo j & " " & d(j) 
next    
wscript.echo ""

i=0
do
  b= DicNextItem(d,i)
  wscript.echo b(0)&" "&b(1)
loop until i=-1 

'---------------------------------------------

Function DicNextItem(dic,i) 
'returns successive items from dictionary ordered by keys
'arguments  dic: the dictionary
'         i: 0 must be passed at fist call, 
'                 returns 1 if there are more items 
'                 returns-1 if no more items   
'returns array with the key in index 0 and the value and value in index 1
'requires rs as global variable (no static in vbs)  
'it supposes the key is a string
      const advarchar=200
      const adopenstatic=3
      dim a(2)
      if i=0 then
        Set rs = CreateObject("ADODB.RECORDSET")
        with rs 
        .fields.append "Key", adVarChar, 100
        .CursorType = adOpenStatic
        .open
        'add all keys to the disconnected recordset  
        for each i in Dic.keys
          .AddNew
          rs("Key").Value = i
          .Update
        next
        .Sort= " Key ASC"
        .MoveFirst
        end with
        i=1
       end if
       if rs.EOF then 
         a=array(nul,nul)
       else
         a(0)=rs(0)
     a(1)=dic(a(0))
         rs.movenext
       end if
       if rs.EOF then i=-1:set rs=nothing
       DicNextItem=a
end function
0
marc_s 28 अक्टूबर 2019, 00:48