컬렉션 확장 클래스 VBA

사용자 지정 개체의 인스턴스 컬렉션을 개체 속성 중 하나를 기반으로 정렬 할 수 있도록 정렬 함수를 만들었습니다. VBA에서 기존 컬렉션 클래스를 확장 할 수 있습니까? 나는 상속이 VBA에서 지원된다는 것을 믿지 않으므로 적절한 방법으로이 문제를 어떻게 해결할 지 확신하지 못합니다. 나는 새로운 모듈을 만들고 그 모듈에 함수를 배치 할 수 있지만, 그렇게하는 가장 좋은 방법은 아닌 것 같다.컬렉션 확장 클래스 VBA

출처

2009-11-18 Irwin M. Fletcher

감사합니다. 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

출처

2009-11-19 14:03:12

텍스트 편집기에서 클래스 모듈을 열고'NewEnum.VB_UserMemID = -4' 함수를'Function NewEnum' 줄 바로 뒤에 추가하여'For Each' 구문을 사용하면됩니다. – RubberDuck