关于vba：默认情况下对一组Classes进行排序


Sort a group of Classes by default property

DR：

是否有任何方法可以将类集合/列表传递给库排序算法，并让它返回排序列表(最好是通过命名/默认类属性)？

我最近学习了一些Python，对Sorted()函数印象深刻，它可以对任何不可测的内容进行排序。对于数字，这很简单，但是对于类，可以指定这样的比较方法。该方法告诉比较运算符如何比较类的两个实例。此外，它还允许您使用内置排序算法对类集合进行排序。

在VBA中，我半成功地模仿了这个。通过设置类的默认成员Attribute，可以直接在类上使用比较运算符(<、=、>=等)。以示例类为例：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name ="defaultProp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private randVal As Single

Public Property Get DefaultValue() As Single
    Attribute Value.VB_UserMemId = 0
    DefaultValue = randVal
End Property

Private Property Let DefaultValue(ByVal value As Single)
    randVal = value
End Property

Private Sub Class_Initialize()
    DefaultValue = Rnd()
End Sub

可以比较此类的两个实例：

1
2
3
4
 Dim instance1 As New defaultProp
 Dim instance2 As New defaultProp
 Debug.Print instance1.DefaultValue > instance2.DefaultValue
 Debug.Print instance1 > instance2 'exactly equivalent, as the DefaultValue has the correct Attribute

号

如果我正在实现一个可以对值排序的VBA排序算法，那么按默认值*对类排序应该没有问题。但是，我更喜欢使用内置/库排序算法(出于同样的原因，任何人都会使用；清晰、高效、正确的错误处理等)。

*其中一个算法可以实现这一点，尽管必须修改以切换整个类轮，而不是它的值(通过添加Sets)

因为vba比较运算符没有问题，所以我假设无论库使用什么，都是一样的。但是，当我尝试使用数组列表时：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub testArrayList()
    Dim arr As Object
    Set arr = CreateObject("System.Collections.ArrayList")

    ' Initialise the ArrayList, for instance by generating random values
    Dim i As Long
    Dim v As defaultProp

    For i = 1 To 5
        Set v = New defaultProp
        arr.Add v 'no problem here
    Next i
    arr.Sort 'raises an error
End Sub

我出错了

Failed to compare two elements in the array

号

怎么了？这是我的方法中的一个缺陷吗？默认属性不是使它成为ArrayList的吗？或者，无论库用什么语言编写，比较运算符都不如VBA和Python使用的Floopy Gloopy？任何关于更多的内置排序算法的建议都是有用的！

在我看来，你把事情混为一谈是在滥用事情。您使用的是vba的默认属性(我通常认为这是一种坏做法)，然后使用.NET的ArrayList，并尝试Sort。

我认为，如果您能在vba类上实现IComparable，然后让ArrayList使用IComparable接口根据您希望比较的对象与其他对象进行比较，而不使用任何被黑客攻击的默认属性，这将更加合乎逻辑。

相关讨论

它不是关于vba比较运算符的，ArrayList是一个.NET类，所以当您使用它时，您将处于.NET世界中。

1
arr.Add v 'no problem here

。

您正在添加defaultProp类的实例；您在类型上有一个默认属性并不重要，.net不关心默认属性。如果您要对DefaultValue值进行排序，那么执行arr.Add v.DefaultValue或arr.Add (v)，那么您的ArrayList将包含它知道如何排序的Single类型的项目。

为了使ArrayList.Sort能够处理自定义类的实例，它的项需要实现IComparable接口，这就是System.Int32接口(即vba中的Long接口)、System.String和其他所有基元.NET类型的情况，我认为vba基元类型确实可以通过.NET interop正确封送，但不能通过.NET interop正确封送。自定义类。

尝试添加对mscorlib.tlb的引用，然后在defaultProp类模块中指定该引用(不能实现在后期绑定库中定义的接口)：

1
Implements IComparable

然后实现接口-应该看起来像这样(使用代码窗格下拉列表确保获得正确的签名-不要只是复制粘贴此代码段：

1
2
3
4
5
6
7
8
9
10
11
12
Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
    Dim other As defaultProp
    Set other = obj
    ' return Less than zero (-1) if this object
    ' is less than the object specified by the CompareTo method.

    ' return Zero (0) if this object is equal to the object
    ' specified by the CompareTo method.

    ' return Greater than zero (1) if this object is greater than
    ' the object specified by the CompareTo method.
End Function

。

既然您的自定义类实现了用于确定defaultProp项如何相互关联的接口ArrayList.Sort，那么我看不出失败的原因。

如果将defaultvalue添加到arr中，它将起作用：

1
2
3
4
5
6
7
8
Sub testArrayList()
    '... code
    For i = 1 To 5
        Set v = New defaultProp
        arr.Add v.DefaultValue
    Next i
    arr.Sort        
End Sub

显然，ArrayList的.Sort的实现有点奇怪，不喜欢比较对象及其默认值(找不到Sort()方法的实现)。尽管如此，这将毫无瑕疵地发挥作用：

1
2
3
4
5
For i = 1 To 5
    Set v = New defaultProp
    arr.Add v
Next i    
Debug.Print arr(1) > arr(2)

号

这是排序的一种可能的实现，可以按预期为arr对象工作。但是，它不是ArrayList库的一部分：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Public Function varBubbleSort(varTempArray As Object) As Object

    Dim varTemp                 As Object
    Dim lngCounter              As Long
    Dim blnNoExchanges          As Boolean

    Do
        blnNoExchanges = True
        For lngCounter = 0 To varTempArray.Count - 2
            If varTempArray(lngCounter) > varTempArray(lngCounter + 1) Then
                blnNoExchanges = False
                Set varTemp = varTempArray(lngCounter)
                varTempArray(lngCounter) = varTempArray(lngCounter + 1)
                varTempArray(lngCounter + 1) = varTemp
            End If
        Next lngCounter

    Loop While Not (blnNoExchanges)
    Set varBubbleSort = varTempArray

   On Error GoTo 0
   Exit Function

End Function

但分类还可以：

enter image description here。

相关讨论