11

我想像List<T>在 C# 上创建一样在 VBA 上创建一个，有什么办法可以做到吗？我在 SO 上寻找有关它的问题，但我找不到任何问题。

4

3 回答 3

22

泛型出现在 C# 2.0 中；在 VB6/VBA 中，您得到的最接近的是Collection. 让你Add,Remove和Count, 但是如果你想要更多的功能, 你需要用你自己的类来包装它AddRange,Clear和Contains.

Collection接受任何Variant（即你扔给它的任何东西），所以你必须<T>通过验证要添加的项目的类型来强制执行。该TypeName()功能可能对此有用。

我接受了挑战：）

更新 在这里查看原始代码

列表.cls

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

类型安全

事情List<T>是T说这个列表是一个确切类型的列表，并且约束意味着一旦我们确定了 的类型T，该列表实例就会坚持它。在 VB6 中，我们可以使用TypeName一个字符串来表示我们正在处理的类型的名称，所以我的方法是让列表知道在添加第一项时它所持有的类型的名称：C# 在 VB6 中以声明方式执行的操作，我们可以将其实现为运行时事物。但这是 VB6，所以我们不要为保持数值类型的类型安全而发疯——我的意思是，我们可以在这里比 VB6 更聪明，归根结底，它不是 C# 代码；该语言对此不是很严格，因此折衷方案可能是仅允许对小于列表中第一项的数字类型进行隐式类型转换。

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为了方便而制作的函数的角色，因此可以在实际添加之前通过客户端代码测试值是否有效。每次我们初始化 aNew List时，this.ItemTypeName该实例都是一个空字符串；剩下的时间我们可能会看到正确的类型，所以我们不要费心检查所有的可能性（不是 C#，评估不会在语句后面的第一个中断）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。现在后者很有趣，因为它也是Collection的默认属性，在 C# 中它被称为索引器属性。在 VB6 中，我们将Item.VB_UserMemId属性设置为 0，我们得到一个默认属性：

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 中，您有一个工具菜单来编辑这些：

过程属性 过程属性

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

该NewEnum.VB_Description属性的一个好处是，无论您在此处输入什么描述，都会在对象浏览器( F2) 中显示为您的代码的描述/迷你文档。

物品存取器/“二传手”

VB6/VBACollection不允许直接将值写入其项目。我们可以分配引用，但不能分配值。我们可以List通过为Item属性提供设置器来实现允许写入 - 因为我们不知道我们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

我的实现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可以采用 aParamArray所以我们可以提供内联值：

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与排序无关，所以我们可以马上实现：

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：

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是调用的结果ToString，该方法返回......类型的名称，包括 T 的类型- 所以我们可以将其设为 aList<T>而不是 a List(Of T)：

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

List<T>允许一次添加多个项目。起初我AddRange用一个参数值的数组来实现，但后来我再次想到，这不是 C#，并且采用 aParamArray非常非常方便：

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二传手：

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

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

IComparable.cls

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

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

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

列表.cls

使用 IComparable 接口

鉴于我们已经打包了IComparablewith 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值可能是什么时，该方法开始发挥作用：

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代码模块：

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

我的类.cls

当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可以这样使用：

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
于 2013-10-03T00:10:14.323 回答
4

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

数组列表

您可以使用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
于 2015-09-01T19:43:40.047 回答
2

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

VBA 的基于索引的集合

VBA 的键值对集合

或者，您可以在 C# 中创建一个类库并在 VBA 中使用。参考这个链接

于 2013-10-03T01:49:22.283 回答