I am trying to sort a dictionary with a function that I found online by an object property which is the Id but on this For Each i In dict line I am getting this error message Microsoft VBScript runtime error: Object doesn't support this property or method. I have tried For Each i In dict.Items but I get the same error message with 'dict.Items' I am using a older version of VBScript so it does not have features like dict.Count
VBScript Class:
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
Sort function:
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
Try modifying your function to:
Function SortDict(dict)
Dim i, j, arrKeys, arrItems
arrKeys = dict.keys 'Array containing the keys
arrItems = dict.Items 'Array containing the Items(which are nothing but objects of class TestClass)
Set tempObj = New TestClass
For i=0 To UBound(arrItems)-1 'From 1st element to the penultimate element
For j=i+1 To UBound(arrItems) 'From i+1th element to last element
If arrItems(i).id < arrItems(j).id Then 'Sorting in DESCENDING ORDER by the Property "ID"
tempObj.ID = arrItems(i).ID
tempObj.TestText = arrItems(i).testText
dict.item(arrKeys(i)).ID = arrItems(j).ID
dict.item(arrKeys(i)).TestText = arrItems(j).TestText
dict.item(arrKeys(j)).ID = tempObj.ID
dict.item(arrKeys(j)).TestText = tempObj.TestText
End If
Next
Next
Set SortDict = dict
End Function
Before Sorting:
|Key |Value |
|----------------|---------------------|
|1 |1,Test1 |
|2 |2,Test2 |
|3 |3,Test3 |
|4 |4,Test4 |
|5 |5,Test5 |
After Sorting:
|Key |Value |
|----------------|---------------------|
|1 |5,Test5 |
|2 |4,Test4 |
|3 |3,Test3 |
|4 |2,Test2 |
|5 |1,Test1 |
I could not find a better way to swap the values. I am sure there is a better way to do that. Will update it once I get something.
To add onto the answers provided by @Potato, I needed to sort by descending two values in a dictionary and compare these values to a database. Luckily the UI allowed me to first sort by descending and then I used the Sorting method provided by @Potato to compare the values to the DB. I would have had to use more dictionaries if I were required to sort more than one value in the DB.
This function takes a dictionary a groups it by similar values such as ID. Then sorts that dictionary by a second value in 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
This function sorts by descending before comparing. Included print statements to see dictionary object.
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
If you need to do a single pass along the dictionary you could use a disconnected recordset to sort the keys, then retrieve the values from the dictionary in the order to get the keys from the recordset.
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
