VBA Arrays - проверить пустой, создать новый, вернуть элемент

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) для нового экземпляра класса (или он просто будет нулевым), вам также нужно использовать 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 Collection. Коллекции быстры для этого и не подвержены резким замедлениям, с которыми вы столкнетесь при увеличении количества элементов.

Вот подход Collection для clsClassA.

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, если вы хотите создать словари.