代码之家 › 专栏 › 技术社区 › Irwin M. Fletcher

扩展集合类VBA

collections vba

Irwin M. Fletcher · 技术社区 · 16 年前

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

3 回复 | 直到 12 年前

Irwin M. Fletcher 16 年前

感谢您的回复。我最终创建了自己的类,它扩展了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

MarkJ 16 年前

一个流行的选择是使用 ADO disconnected recordset 作为一种超能力的集合/字典对象,它内置了对 Sort . 尽管你在使用ADO, don't need a database .

Graham 16 年前

我将创建一个包装类,它公开集合对象的属性,用您自己的排序函数替换排序函数。