VBA中按嵌套类对象属性排序字典后如何保留并输出对应ID键

哎，这个问题我太懂了！你现在的情况是只把字典里的类对象单独抽出来排序，结果和对应的ID键断了联系对吧？别着急，咱们有两种简单的办法解决这个问题，既能按属性排序，又能保留ID和对象的对应关系。

方法一：打包Key和对象一起排序（无需修改类） #

这个思路是把字典的ID键和对应的类对象绑定到同一个数组元素里，排序的时候同时交换两者，这样排序后每个位置都能同时拿到ID和对象的属性。

修改后的完整代码示例 #

首先调整你的Tester过程，把Key和对象一起存入数组：

Sub Tester()
    Dim dict As Object, i As Long, e As Variant
    Dim arr() As Variant, idx As Long
    
    Set dict = CreateObject("scripting.dictionary")
    
    ' 生成测试数据
    For i = 1 To 10
        dict.Add "ID" & i, GetTestObject(i, -i, "Job_" & i)
    Next i
    
    ' 创建一个二维数组：第一列存ID键，第二列存类对象
    ReDim arr(1 To dict.Count, 1 To 2)
    idx = 1
    For Each e In dict.Keys
        arr(idx, 1) = e
        Set arr(idx, 2) = dict(e)
        idx = idx + 1
    Next e
    
    ' 调用带Key的排序方法，按Salary降序排列
    SortObjectsWithKeys arr, "Salary"
    
    ' 输出排序后的结果（包含ID）
    Debug.Print "---------By Salary (Highest to Lowest)-------"
    Debug.Print "ID", "Salary", "Revenue", "Position"
    For i = LBound(arr, 1) To UBound(arr, 1)
        Debug.Print arr(i, 1), arr(i, 2).Salary, arr(i, 2).Revenue, arr(i, 2).Position
    Next i
End Sub

然后新增一个支持Key+对象排序的子过程：

' 排序包含ID键和类对象的二维数组，按指定属性排序
Sub SortObjectsWithKeys(arr As Variant, propName As String)
    Dim First As Long, Last As Long, i As Long, j As Long
    Dim tempKey As String, tempObj As Object
    Dim valI As Variant, valJ As Variant
    
    First = LBound(arr, 1)
    Last = UBound(arr, 1)
    
    ' 冒泡排序逻辑，同时交换Key和对象
    For i = First To Last - 1
        For j = i + 1 To Last
            ' 获取两个对象的指定属性值
            valI = CallByName(arr(i, 2), propName, VbGet)
            valJ = CallByName(arr(j, 2), propName, VbGet)
            
            ' 降序排序（如果要升序，改成valI > valJ即可）
            If valI < valJ Then
                ' 交换ID键
                tempKey = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = tempKey
                
                ' 交换对应的类对象
                Set tempObj = arr(i, 2)
                Set arr(i, 2) = arr(j, 2)
                Set arr(j, 2) = tempObj
            End If
        Next j
    Next i
End Sub

原来的GetTestObject函数和Class1可以完全不用修改，直接用就行。

方法二：给类添加ID属性（需修改类定义） #

如果你允许修改Class1的结构，可以直接给类加一个ID属性，在把对象存入字典时，同步把ID赋值给对象自身。这样排序后，直接从对象里就能拿到ID，不用管字典的Key了。

步骤1：修改Class1 #

打开你的Class1模块，新增一个公共属性：

Public Salary As Double
Public Revenue As Double
Public Position As String
Public ID As String ' 新增ID属性

步骤2：调整Tester过程的赋值逻辑 #

Sub Tester()
    Dim dict As Object, i As Long, itms, e As Variant
    Dim obj As Class1
    
    Set dict = CreateObject("scripting.dictionary")
    
    ' 生成测试数据时，给对象绑定ID
    For i = 1 To 10
        Set obj = GetTestObject(i, -i, "Job_" & i)
        obj.ID = "ID" & i ' 把ID赋值给对象自身
        dict.Add "ID" & i, obj
    Next i
    
    itms = dict.Items
    
    ' 调用原来的SortObjects方法即可
    SortObjects itms, "Salary"
    
    ' 输出时直接从对象取ID
    Debug.Print "---------By Salary (Highest to Lowest)-------"
    Debug.Print "ID", "Salary", "Revenue", "Position"
    For Each e In itms
        Debug.Print e.ID, e.Salary, e.Revenue, e.Position
    Next e
End Sub

这个方法更简洁，但需要修改类的定义，适合你有权限修改类的场景。

两种方法的对比 #

• 方法一：无需修改原有类结构，对现有代码侵入性小，适合不能修改类的情况。
• 方法二：代码更简洁，后续使用对象时随时能拿到ID，适合可以调整类定义的场景。

你可以根据自己的实际需求选其中一种，两种方法都能完美解决你“排序后丢失ID对应关系”的问题~

备注：内容来源于stack exchange，提问作者Erba Aitbayev