Extend Collections Class VBA

Question

我已經創建了一個排序函數來允許基於其中一個對象屬性對自定義對象的實例進行排序。是否可以擴展VBA中的現有集合類？我不相信VBA支持繼承，所以我不知道如何以適當的方式去解決這個問題。我可以創建一個新模塊並將該函數放置在該模塊中，但這似乎不是實現該模塊的最佳方式。

Answer 1

感謝您的回覆。我最終創建了自己的類，它擴展了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 

Answer 2

我會創建一個包裝類，公開對象的屬性，用你自己的替換sort函數。

Answer 3

一種流行的選擇是使用一個ADO disconnected recordset作爲一種hyperpowered收集/字典對象，它有內置的支持Sort的。雖然您正在使用ADO，但您仍可使用don't need a database。