Question

请了解VBA阵列（Access 2003）的人帮助我使用以下代码。

这个想法是ClassA拥有一个动态的ClassB实例数组。动态数组开始为空。当调用者调用ClassA.NewB（）时，会创建一个新的ClassB实例，添加到数组中并返回给调用者。问题是我不能将新的ClassB实例返回给调用者，但是得到“运行时错误91：对象变量或者没有设置块变量”

此外，在UBound（）失败但在另一个函数中包装完全相同的调用时会发生一点WTF！？！？（因此MyUbound（））

我来自C ++背景，这个VBA对我来说有点奇怪！

感谢您的帮助！

主要代码：

Dim a As clsClassA
Dim b As clsClassB

Set a = New clsClassA
a.Init
Set b = a.NewB(0)

clsClassA：

Option Compare Database

Private a() As clsClassB

Public Sub Init()
    Erase a
End Sub

Public Function NewB(i As Integer) As Variant
    'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
    If (MyUBound(a) < i) Then ' WORKS: Returns -1
        ReDim Preserve a(0 To i)
    End If
    NewB = a(i) ' FAILS: Runtime error 91: Object variable or With block variable not set
End Function

Private Function MyUBound(a As Variant) As Long
    MyUBound = UBound(a, 1)
End Function

clsClassB：

Option Compare Database
' This is just a stub class for demonstration purposes
Public data As Integer

Answer 1

试试这个：

Public Function NewB(i As Integer) As Variant
    'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
    If (MyUBound(a) < i) Then ' WORKS: Returns -1
        ReDim Preserve a(0 To i)
    End If

    Set a(i) = New clsClassB

    Set NewB = a(i)
End Function

您需要将（i）设置为该类的新实例（或者它将只是null），您还需要在使用对象时使用Set ...

我或许还建议将NewB的返回类型更改为clsClassB而不是Variant。

您也可以

Public Sub Init()
    ReDim a(0 To 0)
    Set a(0) = New Class2
End Sub

删除了对特殊UBound函数的需求。

Answer 2

您的方法将一组ClassB实例存储在一个数组中。对于您添加的每个实例，必须先重新调整数组。 ReDim是一项昂贵的操作，随着阵列成员数量的增加，它将变得更加昂贵。如果数组只持有一个ClassB实例，那就不会有什么问题了。 OTOH，如果您不打算使用多个ClassB实例，那么将它存储在数组中有什么意义呢？

将实例集合存储在VBA集合中对我来说更有意义。收藏速度很快，并且不会随着项目数量的增长而遇到数组遇到的剧烈减速。

这是clsClassA的Collection方法。

Option Compare Database
Option Explicit
Private mcolA As Collection

Private Sub Class_Initialize()
    Set mcolA = New Collection
End Sub

Private Sub Class_Terminate()
    Set mcolA = Nothing
End Sub

Public Function NewB(ByVal i As Integer) As Object
    Dim objB As clsClassB
    If i > mcolA.Count Then
        Set objB = New clsClassB
        mcolA.Add objB
    Else
        Set objB = Nothing
    End If
    Set NewB = objB
    Set objB = Nothing
End Function

我对clsClassB所做的唯一更改是添加 Option Explicit 。

此过程使用该类。

Public Sub test_ClassA_NewB()
    Dim a As clsClassA
    Dim b As clsClassB

    Set a = New clsClassA
    Set b = a.NewB(1) '' Collections are one-based instead of zero-based
    Debug.Print TypeName(b) ' prints clsClassB
    Debug.Print b.data '' prints 0
    b.data = 27
    Debug.Print b.data '' prints 27
    Set b = Nothing
    Set a = Nothing
End Sub

Answer 3

当您尝试在没有维度的数组上使用它时，UBound函数会抛出此错误（因为您在阵列上执行了Erase，这是您的情况）。您应该在函数中有一个错误处理程序来处理这种情况。

Answer 4

我使用一个特殊的函数来检查数组是否为空，但你可以使用它的一部分进行错误处理。

Public Function IsArrayEmpty(ByRef vArray As Variant) As Boolean

    Dim i As Long

    On Error Resume Next
    IsArrayEmpty = False
    i = UBound(vArray) > 0
    If Err.Number > 0 Then IsArrayEmpty = True
    On Error GoTo 0

End Function

另外，如果你还想做一个数组，那么你可以

redim preserve MyArray(lbound(MyArray) to ubound(MyArray)*2)

这将说明重新安装的次数，你需要一个计数器来在最后重新定位它。

此外，字典应该非常快（并且比集合更通用），它们就像集合，如果你想做字典，你需要添加对Microsoft Scripting Runtime的引用。

VBA数组 - 测试空，创建新的返回元素

4 个答案: