gpt4 book ai didi

vba - 扩展集合类 VBA

转载 作者:行者123 更新时间:2023-12-04 14:32:37 31 4
gpt4 key购买 nike

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

最佳答案

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

关于vba - 扩展集合类 VBA,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/1757877/

31 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com