像List< T>这样的C＃在VBA中

泛型出现在C＃2.0中；但我找不到有关SO的问题。在VB6 / VBA中，最接近的是 Collection 。可让您添加，删除和计数，但是您可以如果您需要更多功能，例如 AddRange ，清除和包含。

Generics appeared in C# 2.0; in VB6/VBA the closest you get is a Collection. Lets you Add, Remove and Count, but you'll need to wrap it with your own class if you want more functionality, such as AddRange, Clear and Contains.

集合需要任何 Variant （即您扔给它的任何东西），因此您必须通过验证项目的类型来强制执行< T> ）被添加。 TypeName（）函数可能对此有用。

Collection takes any Variant (i.e. anything you throw at it), so you'll have to enforce the <T> by verifying the type of the item(s) being added. The TypeName() function would probably be useful for this.

我接受了挑战：）

已更新 在此处查看原始代码

添加VB6 / VBA项目的新类模块。这将定义我们正在实现的 List< T> 的功能。正如[Santosh]的回答表明，我们在选择要包装的什么集合结构上有一些限制。我们可以使用数组，但是将集合作为对象是更好的选择，因为我们希望枚举器在 For Each $中使用 List

Add a new class module to your VB6/VBA project. This will define the functionality of List<T> we're implementing. As [Santosh]'s answer shows we're a little bit restricted in our selection of what collection structure we're going to wrap. We could do with arrays, but collections being objects make a better candidate, since we want an enumerator to use our List in a For Each construct.

具有 List< T&gt ; 是 T 表示此列表是确切类型的列表，并且一旦我们确定了类型 T ，该列表实例将坚持下去。在VB6中，我们可以使用 TypeName 来获取一个表示我们正在处理的类型名称的字符串，因此我的方法是使列表知道在添加第一个项目时所持有的类型的名称：在VB6中C＃声明式执行的操作我们可以将其实现为运行时对象。但这是VB6，所以不要为保持数值类型的类型安全而发疯-我的意思是，我们可以比这里想要的所有版本都比VB6聪明，归根结底，它不是C＃代码。语言不是很强硬，因此折衷办法是只允许对小于列表中第一项大小的数字类型进行隐式类型转换。

The thing with List<T> is that T says this list is a list of what type exactly, and the constraint implies once we determine the type of T, that list instance sticks to it. In VB6 we can use TypeName to get a string representing the name of the type we're dealing with, so my approach would be to make the list know the name of the type it's holding at the very moment the first item is added: what C# does declaratively in VB6 we can implement as a runtime thing. But this is VB6, so let's not go crazy about preserving type safety of numeric value types - I mean we can be smarter than VB6 here all we want, at the end of the day it's not C# code; the language isn't very stiff about it, so a compromise could be to only allow implicit type conversion on numeric types of a smaller size than that of the first item in the list.

Private Type tList
    Encapsulated As Collection
    ItemTypeName As String
End Type
Private this As tList
Option Explicit

Private Function IsReferenceType() As Boolean
    If this.Encapsulated.Count = 0 Then IsReferenceType = False: Exit Function
    IsReferenceType = IsObject(this.Encapsulated(1))
End Function

Public Property Get NewEnum() As IUnknown
    Attribute NewEnum.VB_Description = "Gets the enumerator from encapsulated collection."
    Attribute NewEnum.VB_UserMemId = -4
    Attribute NewEnum.VB_MemberFlags = "40"

    Set NewEnum = this.Encapsulated.[_NewEnum]
End Property

Private Sub Class_Initialize()
    Set this.Encapsulated = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Encapsulated = Nothing
End Sub

验证值是否为适当的类型可以是为方便起见，可以将其设为 public 函数，因此在实际添加值之前，可以通过客户端代码将其测试为有效。每次我们初始化 New List 时， this.ItemTypeName 都是该实例的空字符串；剩下的时间我们可能会看到正确的类型，所以我们不要费心检查所有可能性（不是C＃，在第一个或中，求值不会中断遵循 true 语句）：

Verifying if the value is of the appropriate type can be the role of a function that can be made public for convenience, so a value can be tested to be valid by client code, before it's actually added. Every time we initialize a New List, this.ItemTypeName is an empty string for that instance; the rest of the time we're probably going to see the correct type, so let's not bother checking all possibilities (not C#, evaluation won't break at the first Or that follows a true statement):

Public Function IsTypeSafe(value As Variant) As Boolean

    Dim result As Boolean
    result = this.ItemTypeName = vbNullString Or this.ItemTypeName = TypeName(value)
    If result Then GoTo QuickExit

    result = result _
        Or this.ItemTypeName = "Integer" And StringMatchesAny(TypeName(value), "Byte") _
        Or this.ItemTypeName = "Long" And StringMatchesAny(TypeName(value), "Integer", "Byte") _
        Or this.ItemTypeName = "Single" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte") _
        Or this.ItemTypeName = "Double" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single") _
        Or this.ItemTypeName = "Currency" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single", "Double")

QuickExit:
    IsTypeSafe = result
End Function

现在这是一个开始。

所以我们有一个集合。这样就可以购买我们 Count ，添加，删除和项目。现在后者很有趣，因为它也是 Collection 的 default属性，在C＃中将其称为 indexer 属性。在VB6中，我们将 Item.VB_UserMemId 属性设置为0，然后得到一个默认属性：

So we have a Collection. That buys us Count, Add, Remove, and Item. Now the latter is interesting, because it's also the Collection's default property, and in C# it would be called an indexer property. In VB6 we set the Item.VB_UserMemId attribute to 0 and we get a default property:

Public Property Get Item(ByVal index As Long) As Variant
    Attribute Item.VB_Description = "Gets/sets the item at the specified index."
    Attribute Item.VB_UserMemId = 0

    If IsReferenceType Then
        Set Item = this.Encapsulated(index)
    Else
        Item = this.Encapsulated(index)
    End If
End Property

过程属性

在VBA中，IDE不提供任何编辑方式，但是您可以在记事本中编辑代码，然后将已编辑的.cls文件导入到VBA项目中。在VB6中，您可以使用工具菜单来编辑这些文件：

Procedure Attributes

In VBA the IDE does not provide any way of editing those, but you can edit the code in Notepad and import the edited .cls file into your VBA project. In VB6 you have a Tools menu to edit those:

Attribute NewEnum.VB_UserMemId = -4 告诉VB使用此属性提供枚举数-我们只是将封装的 Collection的那个传递给它，并且它是一个隐藏的属性，以下划线开头（请勿在家中尝试！）。 Attribute NewEnum.VB_MemberFlags = 40 应该也将其设为隐藏属性，但是我还没有弄清楚为什么VB不会选择该属性。因此，为了调用该隐藏属性的getter，我们需要将其括在 [] 方括号中，因为标识符不能合法地以VB6 /下划线开头VBA。

Attribute NewEnum.VB_UserMemId = -4 tells VB to use this property to provide an enumerator - we're just passing it that of the encapsulated Collection, and it being a hidden property it begins with an underscore (don't try this at home!). Attribute NewEnum.VB_MemberFlags = "40" is supposed to make it a hidden property as well, but I haven't yet figured out why VB won't pick up on that one. So in order to call the getter for that hidden property, we need to surround it with [] square brackets, because an identifier can't legally start with an underscore in VB6/VBA.

关于 NewEnum.VB_Description 属性的一件好事是，无论描述如何您输入的位置会显示在对象浏览器（ F2 ）中，作为代码的描述/迷你文档。

One nice thing about the NewEnum.VB_Description attribute is that whatever description you enter there, shows up in the Object Browser (F2) as a description/mini-documentation for your code.

项目访问器/设置者

VB6 / VBA 集合不允许直接将值写入其项目。我们可以分配引用，但不能分配值。我们可以通过为 Item 属性提供设置器来实现启用写功能的 List -因为我们不知道我们是否 T 将是一个值或引用/对象，我们将同时提供 Let 和设置访问器。由于 Collection 不支持此操作，因此我们必须首先删除指定索引处的项目，然后在该位置插入新值。

Item Accessors / "Setters"

The VB6/VBA Collection doesn't allow directly writing values into its items. We can assign references, but not values. We can implement a write-enabled List by providing setters for the Item property - because we don't know if our T will be a value or a reference/object, we'll provide both Let and Set accessors. Since Collection doesn't support this we're going to have to first remove the item at the specified index, and then insert the new value at that place.

好消息， RemoveAt 和 Insert 是我们要使用的两种方法必须实现，而 RemoveAt 是免费提供的，因为其语义与封装的 Collection 的语义相同：

Good news, RemoveAt and Insert are two methods we're going to have to implement anyway, and RemoveAt comes for free because its semantics are the same as those of the encapsulated Collection:

Public Sub RemoveAt(ByVal index As Long)
    this.Encapsulated.Remove index
End Sub

Public Sub RemoveRange(ByVal Index As Long, ByVal valuesCount As Long)
    Dim i As Long
    For i = Index To Index + valuesCount - 1
        RemoveAt Index
    Next
End Sub

我对 Insert 感觉可能会好得多，但是它的本质是读为抓住指定索引后的所有 ，然后进行复制；删除指定索引之后的所有内容；添加指定的值，然后添加其余项：

My implementation of Insert feels like it could get much better, but it essentially reads as "grab everything after the specified index, make a copy; remove everything after the specified index; add the specified value, add back the rest of the items":

Public Sub Insert(ByVal index As Long, ByVal value As Variant)
    Dim i As Long, isObjRef As Boolean
    Dim tmp As New List

    If index > Count Then Err.Raise 9  'index out of range

    For i = index To Count
        tmp.Add Item(i)
    Next

    For i = index To Count
        RemoveAt index
    Next

    Add value
    Append tmp

End Sub

InsertRange 可以使用 ParamArray ，因此我们可以提供内联值：

InsertRange can take a ParamArray so we can supply inline values:

Public Sub InsertRange(ByVal Index As Long, ParamArray values())
    Dim i As Long, isObjRef As Boolean
    Dim tmp As New List

    If Index > Count Then Err.Raise 9  'index out of range

    For i = Index To Count
        tmp.Add Item(i)
    Next

    For i = Index To Count
        RemoveAt Index
    Next

    For i = LBound(values) To UBound(values)
        Add values(i)
    Next
    Append tmp

End Sub

反向与排序无关，因此我们可以立即实现：

Reverse has nothing to do with sorting, so we can implement it right away:

Public Sub Reverse()
    Dim i As Long, tmp As New List

    Do Until Count = 0
        tmp.Add Item(Count)
        RemoveAt Count
    Loop

    Append tmp

End Sub

在这里，我想，因为VB6不支持过载。拥有一个可以添加另一个列表中的所有项目的方法会很好，所以我将其称为 Append ：

Here I thought, since VB6 doesn't support overloads. that it would be nice to have a method that can add all items from another list, so I called that Append:

Public Sub Append(ByRef values As List)
    Dim value As Variant, i As Long
    For i = 1 To values.Count
        Add values(i)
    Next
End Sub

添加是我们的列表变得不仅仅是封装的的地方集合，其中包含一些额外的方法：如果它是添加到列表中的第一项，那么我们可以在此处执行一段逻辑-并不是我不在乎列表中有多少项封装的集合，因此，如果从列表中删除所有项目，则 T 的类型仍然受约束：

Add is where our List becomes more than just an encapsulated Collection with a couple extra methods: if it's the first item being added to the list, we have a piece of logic to execute here - not that I don't care about how many items there are in the encapsulated collection, so if all items are removed from the list the type of T remains constrained:

Public Sub Add(ByVal value As Variant)
    If this.ItemTypeName = vbNullString Then this.ItemTypeName = TypeName(value)
    If Not IsTypeSafe(value) Then Err.Raise 13, ToString, "Type Mismatch. Expected: '" & this.ItemTypeName & "'; '" & TypeName(value) & "' was supplied." 'Type Mismatch
    this.Encapsulated.Add value
End Sub

添加失败时引发的错误的原因是调用 ToString的结果，该方法返回...类型的名称，包括T的类型-因此我们可以将其设为 List< T> 而不是 List（Of T）：

The source of the error raised when Add fails is the result of a call to ToString, a method that returns... the name of the type, including the type of T - so we can make it a List<T> instead of a List(Of T):

Public Function ToString() As String
    ToString = TypeName(Me) & "<" & Coalesce(this.ItemTypeName, "Variant") & ">"
End Function

List< T> 允许一次添加许多项。起初，我实现了 AddRange ，它使用一个参数值数组，但是后来我发现，这是't C＃，并加入 ParamArray 非常方便：

List<T> allows adding many items at once. At first I implemented AddRange with an array of values for a parameter, but then with usage it occurred to me that again, this isn't C#, and taking in a ParamArray is much, much more handy:

Public Sub AddRange(ParamArray values())
    Dim value As Variant, i As Long
    For i = LBound(values) To UBound(values)
        Add values(i)
    Next
End Sub

...然后我们进入那些 Item 设置器：

...And then we get to those Item setters:

Public Property Let Item(ByVal index As Long, ByVal value As Variant)
    RemoveAt index
    Insert index, value
End Property

Public Property Set Item(ByVal index As Long, ByVal value As Variant)
    RemoveAt index
    Insert index, value
End Property

通过提供一个值而不是一个索引来删除项目，将需要另一种方法为我们提供该值的索引，并且因为我们不仅支持值类型以及引用类型，这将非常有趣，因为现在我们需要一种方法来确定平等 n个引用类型-通过比较 ObjPtr（value）可以得到引用相等性，但我们将需要的不仅仅是-。网络框架教会了我有关 IComparable 和 IEquatable 的知识。让我们将这两个接口合并为一个，并称为 IComparable -是的，您可以在VB6 / VBA 中编写和实现接口。

Removing an item by providing a value instead of an index, would require another method that gives us the index of that value, and because we're not only supporting value types but also reference types, this is going to be very fun, because now we need a way to determine equality between reference types - we can get reference equality by comparing ObjPtr(value), but we're going to need more than just that - the .net framework taught me about IComparable and IEquatable. Let's just cram these two interfaces into one and call it IComparable - yes, you can write and implement interfaces in VB6/VBA.

添加一个新的类模块并将其命名为 IComparable -如果您真的打算将它们用于其他用途，则可以将它们放在两个单独的类模块中，并调用另一个 IEquatable ，但这将使您有两个接口可以使用实现，而不是针对您希望使用的所有引用类型。

Add a new class module and call it IComparable - if you really plan to use them for something else then you could put them in two separate class modules and call the other one IEquatable, but that would make you two interfaces to implement instead of one, for all reference types you want to be able to work with.

这不是模型代码，所需要做的只是方法签名：

Option Explicit

Public Function CompareTo(other As Variant) As Integer
'Compares this instance with another; returns one of the following values:
'   -1 if [other] is smaller than this instance.
'    1 if [other] is greater than this instance.
'    0 otherwise.
End Function

Public Function Equals(other As Variant) As Boolean
'Compares this instance with another; returns true if the two instances are equal.
End Function

List.cls

放置IComparable接口以使用

鉴于我们已将 IComparable 与 CompareTo 和等于，我们现在可以在列表中找到任何值的索引；我们还可以确定列表是否包含任何指定值：

List.cls

Putting the IComparable interface to use

Given that we have packed our IComparable with CompareTo and Equals, we can now find the index of any value in our list; we can also determine if the list contains any specified value:

Public Function IndexOf(value As Variant) As Long
    Dim i As Long, isRef As Boolean, comparable As IComparable
    isRef = IsReferenceType
    For i = 1 To this.Encapsulated.Count
        If isRef Then
            If TypeOf this.Encapsulated(i) Is IComparable And TypeOf value Is IComparable Then
                Set comparable = this.Encapsulated(i)
                If comparable.Equals(value) Then
                    IndexOf = i
                    Exit Function
                End If
            Else
                'reference type isn't comparable: use reference equality
                If ObjPtr(this.Encapsulated(i)) = ObjPtr(value) Then
                    IndexOf = i
                    Exit Function
                End If
            End If
        Else
            If this.Encapsulated(i) = value Then
                IndexOf = i
                Exit Function
            End If
        End If
    Next
    IndexOf = -1
End Function

Public Function Contains(value As Variant) As Boolean
    Dim v As Variant, isRef As Boolean, comparable As IComparable
    isRef = IsReferenceType
    For Each v In this.Encapsulated
        If isRef Then
            If TypeOf v Is IComparable And TypeOf value Is IComparable Then
                Set comparable = v
                If comparable.Equals(value) Then Contains = True: Exit Function
            Else
                'reference type isn't comparable: use reference equality
                If ObjPtr(v) = ObjPtr(value) Then Contains = True: Exit Function
            End If
        Else
            If v = value Then Contains = True: Exit Function
        End If
    Next
End Function

CompareTo 方法在以下情况下起作用我们开始询问 Min 和 Max 的值可能是什么：

The CompareTo method comes into play when we start asking what the Min and Max values might be:

Public Function Min() As Variant
    Dim i As Long, isRef As Boolean
    Dim smallest As Variant, isSmaller As Boolean, comparable As IComparable

    isRef = IsReferenceType
    For i = 1 To Count

        If isRef And IsEmpty(smallest) Then
            Set smallest = Item(i)
        ElseIf IsEmpty(smallest) Then
            smallest = Item(i)
        End If

        If TypeOf Item(i) Is IComparable Then
            Set comparable = Item(i)
            isSmaller = comparable.CompareTo(smallest) < 0
        Else
            isSmaller = Item(i) < smallest
        End If

        If isSmaller Then
            If isRef Then
                Set smallest = Item(i)
            Else
                smallest = Item(i)
            End If
        End If
    Next

    If isRef Then
        Set Min = smallest
    Else
        Min = smallest
    End If

End Function

Public Function Max() As Variant
    Dim i As Long, isRef As Boolean
    Dim largest As Variant, isLarger As Boolean, comparable As IComparable

    isRef = IsReferenceType
    For i = 1 To Count

        If isRef And IsEmpty(largest) Then
            Set largest = Item(i)
        ElseIf IsEmpty(largest) Then
            largest = Item(i)
        End If

        If TypeOf Item(i) Is IComparable Then
            Set comparable = Item(i)
            isLarger = comparable.CompareTo(largest) > 0
        Else
            isLarger = Item(i) > largest
        End If

        If isLarger Then
            If isRef Then
                Set largest = Item(i)
            Else
                largest = Item(i)
            End If
        End If
    Next

    If isRef Then
        Set Max = largest
    Else
        Max = largest
    End If

End Function

这两个函数允许可读的排序-由于发生了什么（添加和删除项目），我们将不得不快速失败：

These two functions allow a very readable sorting - because of what's going on here (adding & removing items), we're going to have to fail fast:

Public Sub Sort()
    If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: Sort() requires a list of numeric or string values, or a list of objects implementing the IComparer interface."
    Dim i As Long, value As Variant, tmp As New List, minValue As Variant, isRef As Boolean

    isRef = IsReferenceType
    Do Until Count = 0

        If isRef Then
            Set minValue = Min
        Else
            minValue = Min
        End If

        tmp.Add minValue
        RemoveAt IndexOf(minValue)
    Loop

    Append tmp

End Sub

Public Sub SortDescending()
    If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: SortDescending() requires a list of numeric or string values, or a list of objects implementing the IComparer interface."
    Dim i As Long, value As Variant, tmp As New List, maxValue As Variant, isRef As Boolean

    isRef = IsReferenceType
    Do Until Count = 0

        If isRef Then
            Set maxValue = Max
        Else
            maxValue = Max
        End If

        tmp.Add maxValue
        RemoveAt IndexOf(maxValue)
    Loop

    Append tmp

End Sub

最后的接触

其余的只是琐碎的事情：

The final touch

The rest is just trivial stuff:

Public Sub Remove(value As Variant)
    Dim index As Long
    index = IndexOf(value)
    If index <> -1 Then this.Encapsulated.Remove index
End Sub

Public Property Get Count() As Long
    Count = this.Encapsulated.Count
End Property

Public Sub Clear()
    Do Until Count = 0
        this.Encapsulated.Remove 1
    Loop
End Sub

Public Function First() As Variant
    If Count = 0 Then Exit Function
    If IsObject(Item(1)) Then
        Set First = Item(1)
    Else
        First = Item(1)
    End If
End Function

Public Function Last() As Variant
    If Count = 0 Then Exit Function
    If IsObject(Item(Count)) Then
        Set Last = Item(Count)
    Else
        Last = Item(Count)
    End If
End Function

关于 List< T> 的一件有趣的事是通过调用 ToArray（）复制到数组中-我们可以完全做到这一点：

One fun thing about List<T> is that it can be copied into an array just by calling ToArray() on it - we can do exactly that:

Public Function ToArray() As Variant()

    Dim result() As Variant
    ReDim result(1 To Count)

    Dim i As Long
    If Count = 0 Then Exit Function

    If IsReferenceType Then
        For i = 1 To Count
            Set result(i) = this.Encapsulated(i)
        Next
    Else
        For i = 1 To Count
            result(i) = this.Encapsulated(i)
        Next
    End If

    ToArray = result
End Function

仅此而已！

我正在使用一些辅助函数，它们在这里-它们可能属于某些 StringHelpers 代码模块：

I'm using a few helper functions, here they are - they probably belong in some StringHelpers code module:

Public Function StringMatchesAny(ByVal string_source As String, find_strings() As Variant) As Boolean

    Dim find As String, i As Integer, found As Boolean

    For i = LBound(find_strings) To UBound(find_strings)

        find = CStr(find_strings(i))
        found = (string_source = find)

        If found Then Exit For
    Next

    StringMatchesAny = found

End Function

Public Function Coalesce(ByVal value As Variant, Optional ByVal value_when_null As Variant = 0) As Variant

    Dim return_value As Variant
    On Error Resume Next 'supress error handling

    If IsNull(value) Or (TypeName(value) = "String" And value = vbNullString) Then
        return_value = value_when_null
    Else
        return_value = value
    End If

    Err.Clear 'clear any errors that might have occurred
    On Error GoTo 0 'reinstate error handling

    Coalesce = return_value

End Function

MyClass.cls

当 T $ c时，此实现需要$ c>是引用类型/对象，即类实现 IComparable 接口以便可排序并查找值的索引。这样做的方法-假设您有一个名为 MyClass 的类，该类具有一个名为 String 属性> SomeProperty ：

MyClass.cls

This implementation requires, when T is a reference type / object, that the class implements the IComparable interface in order to be sortable and for finding the index of a value. Here's how it's done - say you have a class called MyClass with a numeric or String property called SomeProperty:

Implements IComparable
Option Explicit

Private Function IComparable_CompareTo(other As Variant) As Integer
    Dim comparable As MyClass
    If Not TypeOf other Is MyClass Then Err.Raise 5

    Set comparable = other
    If comparable Is Nothing Then IComparable_CompareTo = 1: Exit Function

    If Me.SomeProperty < comparable.SomeProperty Then
        IComparable_CompareTo = -1
    ElseIf Me.SomeProperty > comparable.SomeProperty Then
        IComparable_CompareTo = 1
    End If

End Function

Private Function IComparable_Equals(other As Variant) As Boolean
    Dim comparable As MyClass
    If Not TypeOf other Is MyClass Then Err.Raise 5

    Set comparable = other
    IComparable_Equals = comparable.SomeProperty = Me.SomeProperty

End Function

可以使用 List 像这样：

Dim myList As New List
myList.AddRange 1, 12, 123, 1234, 12345 ', 123456 would blow up because it's a Long
myList.SortDescending

Dim value As Variant
For Each value In myList
   Debug.Print Value
Next

Debug.Print myList.IndexOf(123) 'prints 3
Debug.Print myList.ToString & ".IsTypeSafe(""abc""): " & myList.IsTypeSafe("abc")
    ' prints List<Integer>.IsTypeSafe("abc"): false