按嵌套类对象数据对字典进行排序 [VBA]

Question

我有一个Dictionary，其中ID（字符串）作为

Key

，嵌套类object作为其

Item

。字典看起来像这样：

Key: "ID1", Item: obj1
Key: "ID2", Item: obj2
Key: "ID3", Item: obj3

等等...

每个类对象都有字段：

Public Salary As Double
Public Revenue As Double
Public Position As String

---

这是代码：

Sub Tester()

    Dim dict As Object, i As Long, itms, e
    Set dict = CreateObject("scripting.dictionary")
    
    'some test data for Dictionary
    For i = 1 To 10
        dict.Add "ID" & i, GetTestObject(i, -i, "Job_" & i)
    Next i
    itms = dict.Items
     
    'Calling sort by "salary"
    SortObjects itms, "Salary"
    
    Debug.Print "---------By Salary (Highest to Lowest)-------"
    For Each e In itms
        Debug.Print e.Salary, e.Revenue, e.Position
    Next e
       
End Sub

---

测试 Function 返回的类对象：

Function GetTestObject(slr As Long, rvn As Long, pst As String)
    Dim obj As New Class1
    obj.Salary = slr
    obj.Revenue = rvn
    obj.Position = pst
    Set GetTestObject = obj
End Function

字典中的项目排序是这样完成的：

'Sorting an array of objects using a given property 'propName'
Sub SortObjects(list, propName As String)
    Dim First As Long, Last As Long, i As Long, j As Long, vTmp, oTmp As Object, arrComp()
    First = LBound(list)
    Last = UBound(list)
    'fill the "compare" array...
    ReDim arrComp(First To Last)
    For i = First To Last
        arrComp(i) = CallByName(list(i), propName, VbGet)
    Next i
    'now sort by comparing on `arrComp` not `list`
    For i = First To Last - 1
        For j = i + 1 To Last
            If arrComp(i) < arrComp(j) Then
                vTmp = arrComp(j)          'swap positions in the "comparison" array
                arrComp(j) = arrComp(i)
                arrComp(i) = vTmp
                Set oTmp = list(j)             '...and in the original array
                Set list(j) = list(i)
                Set list(i) = oTmp
            End If
        Next j
    Next i
End Sub

---

我打印字典：

    Debug.Print "---------By Salary (Highest to Lowest)-------"
    For Each e In itms
        Debug.Print e.Salary, e.Revenue, e.Position
    Next e

---

结果：

---------By Salary (Highest to Lowest)-------
 10           -10           Job_10
 9            -9            Job_9
 8            -8            Job_8
 7            -7            Job_7
 6            -6            Job_6
 5            -5            Job_5
 4            -4            Job_4
 3            -3            Job_3
 2            -2            Job_2
 1            -1            Job_1

因此，它按 Salary 正确排序，并且我打印了相应的值 Salary Revenue 和 Job。并且按降序打印正确。

---

但是我怎样才能按排序顺序打印每个元素及其 ID (Key) 呢？ 我得到了 Items（对象） 的排序数组并打印出来。我怎样才能访问并打印

ID (Key)

的排序字典中每个元素对应的

<IDs>, <objects>

？

---

基本上，我得到了字典的排序数据，但我丢失了元素与其ID（键）的连接。我该如何解决？

Answer 1

据我所知，字典不保证任何排序顺序。我的建议是不要对字典进行排序，而是对字典键的数组进行排序。使用该排序数组来访问字典的元素。字典本身保持不变。

您的测试程序的代码如下所示

'Calling sort by "salary"
Dim sortedkeys, key
sortedkeys = SortObjects(dict, "Salary", False)
Debug.Print "---------By Salary (Highest to Lowest)-------"
For Each key In sortedkeys
    Dim e As Class1
    Set e = dict(key)
    Debug.Print key, e.Salary, e.Revenue, e.Position
Next key

返回排序后的键的排序例程（现在是一个函数）保持字典不变，将键读入数组，并通过读取存储在字典中的项目的给定属性来对该数组进行排序。我添加了一个可选参数，以便例程可以按升序或降序排序 - 当然，您也可以通过向后遍历已排序的数组来存档它。

' Sorting the keys of a dictionary using a given property 'propName'
Function SortObjects(dict As Dictionary, propName As String, Optional ascending As Boolean = True) As Variant
    Dim keys
    keys = dict.keys
    
    Dim i As Long, j As Long
    For i = LBound(keys) To UBound(keys) - 1
        For j = i + 1 To UBound(keys)
            Dim v1, v2
            v1 = CallByName(dict(keys(i)), propName, VbGet)
            v2 = CallByName(dict(keys(j)), propName, VbGet)
        
            If (v1 > v2 And ascending) Or (v1 < v2 And Not ascending) Then
                Dim vTmp
                vTmp = keys(j)          'swap positions in the "comparison" array
                keys(j) = keys(i)
                keys(i) = vTmp
            End If
        Next j
    Next i
    SortObjects = keys
End Function