扩展集合类 VBA

Extend Collections Class VBA

提问by Irwin M. Fletcher

I have created a sort function to allow a collection of instances of a custom object to be sorted based on one of the objects properties. Is it possible to extend the existing collections class in VBA? I do not believe inheritance is supported in VBA, so I am not sure how to go about this in the proper way. I could just create a new module and place the function in that module, but that doesn't seem like the best way of doing it.

我创建了一个排序函数，允许根据对象属性之一对自定义对象的实例集合进行排序。是否可以在 VBA 中扩展现有的集合类？我不相信 VBA 支持继承，所以我不确定如何以正确的方式解决这个问题。我可以创建一个新模块并将函数放在该模块中，但这似乎不是最好的方法。

回答by Irwin M. Fletcher

Thanks for the responses. I ended up creating my own class which extends the Collections class in VBA. Below is the code if anyone is interested.

感谢您的回复。我最终创建了自己的类，它扩展了 VBA 中的 Collections 类。如果有人感兴趣，下面是代码。

'Custom collections class is based on the Collections class, this class extendes that
'functionallity so that the sort method for a collection of objects is part of
'the class.

'One note on this class is that in order to make this work in VBA, the Attribute method has to be added
'manually.  To do this, create the class, then export it out of the project.  Open in a text editor and
'add this line Attribute Item.VB_UserMemId = 0 under the Item() function and this line
'Attribute NewEnum.VB_UserMemId = -4 under the NewEnum() function.  Save and import back into project.
'This allows the Procedure Attribute to be recognized.

Option Explicit

Private pCollection As Collection

Private Sub Class_Initialize()
    Set pCollection = New Collection
End Sub

Private Sub Class_Terminate()
    Set pCollection = Nothing
End Sub

Function NewEnum() As IUnknown
    Set NewEnum = pCollection.[_NewEnum]
End Function

Public Function Count() As Long
    Count = pCollection.Count
End Function

Public Function item(key As Variant) As clsCustomCollection
    item = pCollection(key)
End Function

'Implements a selection sort algorithm, could likely be improved, but meets the current need.
Public Sub SortByProperty(sortPropertyName As String, sortAscending As Boolean)

    Dim item As Object
    Dim i As Long
    Dim j As Long
    Dim minIndex As Long
    Dim minValue As Variant
    Dim testValue As Variant
    Dim swapValues As Boolean

    Dim sKey As String

    For i = 1 To pCollection.Count - 1
        Set item = pCollection(i)
        minValue = CallByName(item, sortPropertyName, VbGet)
        minIndex = i

        For j = i + 1 To pCollection.Count
            Set item = pCollection(j)
            testValue = CallByName(item, sortPropertyName, VbGet)

            If (sortAscending) Then
                swapValues = (testValue < minValue)
            Else
                swapValues = (testValue > minValue)
            End If

            If (swapValues) Then
                minValue = testValue
                minIndex = j
            End If

            Set item = Nothing
        Next j

        If (minIndex <> i) Then
            Set item = pCollection(minIndex)

            pCollection.Remove minIndex
            pCollection.Add item, , i

            Set item = Nothing
        End If

        Set item = Nothing
    Next i

End Sub

Public Sub Add(value As Variant, key As Variant)
    pCollection.Add value, key
End Sub

Public Sub Remove(key As Variant)
    pCollection.Remove key
End Sub

Public Sub Clear()
    Set m_PrivateCollection = New Collection
End Sub

回答by MarkJ

One popular option is to use an ADO disconnected recordsetas a sort of hyperpowered collection/dictionary object, which has built-in support for Sort. Although you are using ADO, you don't need a database.

一个流行的选择是使用ADO 断开连接的记录集作为一种超能力集合/字典对象，它具有对Sort 的内置支持。尽管您使用的是 ADO，但您不需要数据库。

回答by Graham

I would create a wrapper class that exposes the collection object's properties, substituting the sort function with your own.

我将创建一个公开集合对象属性的包装类，用您自己的功能替换 sort 函数。