代码之家 › 专栏 › 技术社区 › leora Matt Lacey

在excel VBA中,如何按项的字段对字典排序(类似于C#orderby)?

dictionary sorting vba excel

leora Matt Lacey · 技术社区 · 5 年前

我在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中是否可行?

0 回复 | 直到 5 年前

mmikesy90 5 年前

字典不能按照您建议的开箱即用的方式进行排序。

除了其他人在评论中提出的建议之外,您还可以考虑使用ADODB。具有丰富和快速排序功能的记录集。

请访问此网站以获取进一步指导 ADODB.Recordset

这样一来,你就失去了字典的一些便利功能,但就你的目的而言,我知道你并不需要它们。

Tim Williams 5 年前

这里有一种方法:

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