C＃与VBA中的List 类似
我想在VBA上创建一个List ，就像你在C＃上创建一样，我有什么方法可以做到这一点？ 我在这里寻找有关它的问题，但我找不到任何问题。
generics出现在C＃2.0中; 在VB6 / VBA中，你得到的最接近的是Collection 。 允许您Add ， Remove和Count ，但如果您需要更多function，则需要使用自己的类包装它，例如AddRange ， Clear和Contains 。
Collection任何Variant （即你抛出的任何东西），因此你必须通过validation正在添加的项目的类型来强制执行TypeName()函数可能对此有用。
我接受了挑战:)
更新了 原始代码
List.cls
将新的类模块添加到VB6 / VBA项目中。 这将定义我们正在实现的List的function。 正如[Santosh]的回答所示，我们在选择我们要包装的收集结构方面有点受限制。 我们可以使用数组，但是作为对象的集合是一个更好的候选者，因为我们希望枚举器在For Each结构中使用我们的List 。
类型安全
List的东西是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
validation值是否属于适当的类型可以是可以为方便起见而public的函数的角色，因此在实际添加之前，可以通过客户端代码测试值是否有效。 每次初始化New 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属性的一个NewEnum.VB_Description是，无论您在那里输入什么描述，都会在对象浏览器 （ F2 ）中显示为代码的描述/迷你文档。
物品存取物/“定位器”
VB6 / VBA Collection不允许直接将值写入其项目。 我们可以分配引用 ，但不能分配值 。 我们可以通过为Item属性提供setter来实现一个支持写入的List – 因为我们不知道我们的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可以采用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与排序无关，因此我们可以立即实现：
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的类型 – 所以我们可以使它成为List而不是List(Of T) ：
Public Function ToString() As String ToString = TypeName(Me) & "<" & Coalesce(this.ItemTypeName, "Variant") & ">" End Function
List允许一次添加多个项目。 起初我用一个参数的值数组实现了AddRange ，但随后使用它再次发生，这不是C＃，并且接受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 setter：
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
List.cls
使用IComparable接口
鉴于我们已将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
当我们开始询问Min和Max值可能是什么时， CompareTo方法开始起作用：
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一个有趣的事情是它可以通过调用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
MyClass.cls
当T是引用类型/对象时，此实现需要该类实现IComparable接口，以便可排序并查找值的索引。 以下是它的完成方式 – 假设您有一个名为MyClass的类，其中包含一个名为MyClass的数字或String属性：
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.IsTypeSafe("abc"): false
List是基于索引的集合 ，它允许将任何数据类型附加到集合对象，这在VBA中是不可能的。
基于索引的VBA集合
- 数组 – 在MSDN上， 声明和使用 。 另见Wikibooks 。
VBA的键值对集合
- collections – MSDN ， Wikibooks
- Dictonary – MSDN ， Wikibooks
或者，您可以在C＃中创建一个类库，并在VBA中使用。 请参阅此链接
我知道这是一个老post，但除了讨论的内容之外，我还想提及以下内容……
数组列表
您可以使用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