Question

我想在VBA上创建一个List<T>，就像你在C＃上创建一样，我有什么方法可以做到这一点？我在这里找了关于它的问题，但我找不到任何问题。

Answer 1

泛型出现在C＃2.0中;在VB6 / VBA中，你得到的最接近的是Collection。允许您Add，Remove和Count，但如果您需要更多功能，例如AddRange，{Clear，则需要使用自己的类包装它1}}和Contains。

Collection接受任何Variant（即您向其投掷的任何内容），因此您必须通过验证项目的类型来强制执行<T>添加。 TypeName()函数可能对此有用。

我接受了挑战：）

已更新 see original code here

List.cls

将新的类模块添加到VB6 / VBA项目中。这将定义我们正在实施的List<T>的功能。正如[Santosh]的回答所示，我们选择我们将要包装的收集结构时，我们受到了一点限制。我们可以使用数组，但是作为对象的集合可以成为更好的候选者，因为我们希望枚举器在List构造中使用For Each。

类型安全

List<T>的内容是T说此列表是一个完全类型的列表，一旦我们确定{{1}的类型，约束就意味着那个列表实例坚持下去。在VB6中，我们可以使用T来获取表示我们正在处理的类型名称的字符串，因此我的方法是使列表知道类型的名称它是在第一个项目被添加的时刻举行的：C＃在VB6中声明性地执行了什么我们可以实现为运行时事物。但这是VB6，所以让我们不要为保留数值类型的类型安全而疯狂 - 我的意思是我们可以在这里完全比VB6更聪明，在一天结束时它不是C＃代码;该语言并不十分严格，因此折衷方案可能只允许对数字类型的隐式类型转换，这些数字类型的大小小于列表中第一项的大小。

TypeName

验证值是否属于适当的类型可以是函数的角色，为方便起见可以使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都是该实例的空字符串;其余的时间我们可能会看到正确的类型，所以让我们不要费心检查所有可能性（不是C＃，评估在第一个this.ItemTypeName之后不会中断Or声明：

true

现在这是一个开始。

所以我们有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。这会购买我们Collection，Count，Add和Remove。现在后者很有趣，因为它也是Item的默认属性，而在C＃中它将被称为索引器属性。在VB6中，我们将Collection属性设置为0，我们得到默认属性：

Item.VB_UserMemId

过程属性

在VBA中，IDE不提供任何编辑方式，但您可以在记事本中编辑代码并将已编辑的.cls文件导入到VBA项目中。在VB6中，您有一个工具菜单来编辑它们：

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告诉VB使用此属性来提供枚举器 - 我们只是将它传递给封装的Attribute NewEnum.VB_UserMemId = -4，并且它是一个隐藏的属性，它以下划线开头（don＆＃39;在家尝试这个！）。 Collection也应该把它变成一个隐藏的属性，但我还没弄明白为什么VB不会接受那个。因此，为了为隐藏属性调用getter，我们需要用Attribute NewEnum.VB_MemberFlags = "40"方括号括起来，因为标识符不能合法地以VB6 / VBA中的下划线开头。

关于[]属性的一个好处是，无论你在那里输入什么描述，都会在对象浏览器（ F2 ）中显示为描述/迷你-documentation for your code。

项目访问者/＆＃34; Setters＆＃34;

VB6 / VBA NewEnum.VB_Description不允许直接将值写入其项目。我们可以分配引用，但不能分配值。我们可以通过为Collection属性提供setter来实现支持写入的List - 因为我们不知道我们的Item是值还是引用/对象，我们和＃39;将提供T和Let个访问者。由于Set不支持此功能，因此我们必须首先删除指定索引处的项目，然后在该位置插入新值。

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

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的实现感觉它可以变得更好，但它本质上读作＆＃34;在指定的索引之后抓取所有，制作副本;删除指定索引后的所有内容;添加指定的值，添加其余项目＆＃34;：

Insert

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

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

我想，因为VB6不支持重载。如果有一个方法可以添加其他列表中的所有项目，那就好了，所以我调用了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：

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我们的Add不仅仅是一个封装的List，还有一些额外的方法：如果它是第一个添加到列表中的项目，我们有这里要执行的逻辑 - 不是我不关心封装集合中有多少项，所以如果从列表中删除所有项目，Collection的类型仍然受到限制：

T

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失败时引发的错误来源是调用Add的结果，该方法返回...类型的名称，包括T的类型 - 因此我们可以将其设为ToString而不是List<T>：

List(Of T)

Public Function ToString() As String ToString = TypeName(Me) & "<" & Coalesce(this.ItemTypeName, "Variant") & ">" End Function允许一次添加多个项目。我首先使用参数的值数组实现了List<T>，但随后又使用了它，我再次发现，这不是C＃，并且接受AddRange非常多更方便：

ParamArray

...然后我们找到那些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

通过提供值而不是索引来删除项目，需要另一种方法来为我们提供该值的索引，并且因为我们不仅支持值类型而且还< em>引用类型，这将非常有趣，因为现在我们需要一种方法来确定引用类型之间的相等 - 我们可以通过以下方式获得引用相等比较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，但我们需要的不仅仅是那个 - .net框架教会我ObjPtr(value)和IComparable。让我们把这两个接口塞进一个并调用它IEquatable - 是的，你可以在VB6 / VBA中编写和实现接口。

IComparable.cls

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

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

IEquatable

List.cls

使用IComparable接口

鉴于我们已将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与IComparable和CompareTo打包在一起，我们现在可以在列表中找到任意值的索引;我们还可以确定列表是否包含任何指定的值：

Equals

当我们开始询问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

这两个功能允许非常易读的排序 - 由于此处发生了什么（添加和删除项目），我们必须快速失败：< / p>
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

最后的触摸

其余的只是微不足道的事情：

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

关于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()

这就是全部！

我使用了一些辅助函数，这里它们是 - 它们可能属于某些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

MyClass.cls

当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是引用类型/对象时，此实现要求类实现T接口以便可排序并查找值的索引。以下是它的完成方式 - 假设您有一个名为IComparable的类，其中包含一个名为MyClass的数字或String属性：

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

Answer 2

List<T>是基于索引的集合，它允许将任何数据类型附加到集合对象，这在VBA中是不可能的。

基于索引的VBA集合

阵列 - 在MSDN上，declaring和using。另请参阅Wikibooks。

VBA的键值对集合

收藏 - MSDN，Wikibooks
Dictonary - MSDN，Wikibooks

或者，您可以在C＃中创建一个类库，并在VBA中使用。请参阅此link

Answer 3

我知道这是一篇旧帖子，但除了讨论的内容之外，我还想提及以下内容......

数组列表

您可以使用ArrayList，它是VBA中可用的弱类型（使用对象，非强类型）链接列表。这是一些展示基本用法的示例代码。

Sub ArrayListDemo()
    Dim MyArray(1 To 7) As String
    MyArray(1) = "A"
    MyArray(2) = "B"
    MyArray(3) = "B"
    MyArray(4) = "i"
    MyArray(5) = "x"
    MyArray(6) = "B"
    MyArray(7) = "C"
    Set L1 = ToList(MyArray)
    L1.Insert L1.LastIndexOf("B"), "Zz"
    Set L2 = L1.Clone
    L2.Sort
    L2.Reverse
    L2.Insert 0, "----------------"
    L2.Insert 0, "Sort and Reverse"
    L2.Insert 0, "----------------"
    L1.AddRange L2.Clone
    Set L3 = SnipArray(L1, 9, 3)
    Debug.Print "---- L1 Values ----"
    For Each obj In L1
        Debug.Print obj & " (L1 & L3 = " & L3.Contains(obj) & ")"
    Next
    Debug.Print "---- L3 Values ----"
    For Each obj In L3
        Debug.Print obj
    Next
End Sub
Function ToList(ByVal Arr As Variant) As Object
    Set ToList = CreateObject("System.Collections.ArrayList")
    For Each Elm In Arr
      ToList.Add Elm
    Next Elm
End Function
Function SnipArray(ByVal ArrayList As Object, lower As Integer, length As Integer) As Object
    Set SnipArray = ArrayList.Clone
    lower = lower - 1
    upper = lower + length
    If upper < ArrayList.Count Then
        SnipArray.RemoveRange upper, (ArrayList.Count - upper)
    End If
    If lower > 0 Then
        SnipArray.RemoveRange 0, lower
    End If
End Function

<强>词典

另外，很高兴看到字典被提及。以下是关于如何在VBA中使用字典并将其用作列表的几个注意事项：

Sub DictionaryDemo()
    'If you have a reference to "Microsoft Scripting Runtime..."'
    Set D = New Dictionary
    'Else use this if you do not want to bother with adding a reference'
    Set D = CreateObject("Scripting.Dictionary")

    'You can structure a dictionary as a zero based array like this'
    D.Add D.Count, "A"
    Debug.Print D(0)

    Set D = Nothing
End Sub

C＃如VBA中的List <t> </t>

3 个答案:

List.cls

类型安全

过程属性

项目访问者/＆＃34; Setters＆＃34;

IComparable.cls

List.cls

使用IComparable接口

最后的触摸

MyClass.cls