excel - 在 excel VBA 中，如何按 Item 的字段对字典进行排序（类似于 C# orderby）？

Question

我在 excel VBA 中有一个字典，其中键是字符串（SS #），值是具有 3 个属性（姓名、出生日期和工作名称）的对象

Dim d as Dictionary
Set d = new Dictionary

d.Add "123", obj
d.Add "234", obj2
d.Add "342", obj3

我想按生日的顺序打印一张表格。在 C# 中，我会做这样的事情

for each (var item in dict.Items.Orderby(r=>r.Birthdate))

但我无法在 VBA 中弄清楚如何按该字典中项目的出生日期对该字典进行排序。

这在 Excel VBA 中可行吗？

标签： excelvbasortingdictionary

Answer 1

这是一种方法：

Sub Tester()

    Dim dict As Object, i As Long, dt As Date, itms, e

    Set dict = CreateObject("scripting.dictionary")
    'some test data
    For i = 1 To 10
        dt = Now - Application.RandBetween(500, 5000)
        dict.Add "Object_" & i, GetTestObject("Name_" & i, dt, "Job_" & i)
    Next i
    itms = dict.items
    
    'Stop
    SortObjects itms, "BirthDate"
    Debug.Print "---------Birthdate-------"
    For Each e In itms
        Debug.Print e.Name, e.BirthDate, e.JobName
    Next e
    
    SortObjects itms, "JobName"
    Debug.Print "---------JobName-------"
    For Each e In itms
        Debug.Print e.Name, e.BirthDate, e.JobName
    Next e
    
End Sub

Function GetTestObject(nm As String, dt As Date, jb As String)
    Dim obj As New clsTest
    obj.Name = nm
    obj.BirthDate = dt
    obj.JobName = jb
    Set GetTestObject = obj
End Function

'Sort 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