如何通过对象属性对字典进行排序vbscript

Question

我正在尝试使用一个我在网上找到的函数按照对象属性（即Id）对字典进行排序，但是在这个For Each i In dict行中，我收到了这个错误信息：Microsoft VBScript运行时错误：对象不支持此属性或方法。我尝试了For Each i In dict.Items，但是我得到了相同的“dict.Items”错误消息。我使用的是较旧版本的VBScript，因此没有像dict.Count这样的功能。

VBScript类：

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

- Dev

---

你的代码应该可以直接运行。否则尝试使用 For Each i In dict.keys。如果这不起作用，请尝试使用字符串键 (gDic.Add CStr(i), temp)。 - Salman A

我想对对象属性进行排序。我有一个对象集合，我希望按对象ID或对象中的任何其他属性进行排序。适用于任何类型的集合。 - Dev

将其放入具有 .Sort 和 .Reverse 的 Collections.ArrayList 中，如果必须在字典中，则将其写回其中。 - SupermanKelly

Answer 1

尝试修改你的函数为以下内容：

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

排序前：

|Key             |Value                |
|----------------|---------------------|
|1               |1,Test1              |
|2               |2,Test2              |
|3               |3,Test3              |
|4               |4,Test4              |
|5               |5,Test5              |

排序后：

|Key             |Value                |
|----------------|---------------------|
|1               |5,Test5              |
|2               |4,Test4              |
|3               |3,Test3              |
|4               |2,Test2              |
|5               |1,Test1              |

我找不到更好的交换值的方法。我相信有更好的方法来做这件事。一旦我找到了，就会更新它。

- Gurmanjot Singh

Answer 2

如果你需要对字典进行单次遍历，可以使用一个断开连接的记录集来对键进行排序，然后按顺序从字典中检索值以获取来自记录集的键。

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

- Antoni Gual Via

Answer 3

为了补充@Potato提供的答案，我需要按照字典中两个值的降序排序，并将这些值与数据库进行比较。幸运的是，UI允许我先按降序排序，然后使用@Potato提供的排序方法将值与DB进行比较。如果需要在DB中排序多个值，则必须使用更多的字典。

此函数接受一个字典并将其按类似值（例如ID）分组。然后通过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 

- William Humphries

Answer 4

我会将字典数据加载到一个具有排序选项的 Collections.ArrayList 中。如果需要它变成字典，那么排序后再重新加载回去。

' Load Dictionary with unsorted data
set oDic = CreateObject("Scripting.Dictionary")
oDic.add "5", "Test5"
oDic.add "3", "Test3"
oDic.add "4", "Test4"
oDic.add "1", "Test1"
oDic.add "2", "Test2"

' Create Collections.Arraylist and load with Dictionary data
dim list
Set list = CreateObject("System.Collections.ArrayList")

For Each obj in oDic.keys
    'Msgbox "Key: " & obj & " Value: " & oDic(obj)
    list.Add obj & "|" & oDic(obj)
Next

' Arraylist Sort/Reverse options
list.Sort
'list.Reverse 'Use this is want to reverse sort

'Clear Dictionary so can reload 
oDic.RemoveAll

For i = 0 To list.Count - 1
    a=Split(list.Item(i), "|")
    oDic.add a(0), a(1)
Next

' Data now back in your dictionary if needs to be
For Each obj in oDic.keys
    WScript.Echo "Key: " & obj & VbCrLf & "Value: " & oDic(obj)
Next

- SupermanKelly

---

嗯，如果你这样做，我很确定它会排序1、11、12、2、3、4... - Geert Bellekens

列表中甚至没有11或12，那怎么可能呢？复制并粘贴运行。输出按1到5的顺序排列。 - SupermanKelly

我认为可以安全地假设原帖作者试图解决的实际问题不是仅对包含5个元素的列表进行排序。 - Geert Bellekens