Массив не изменяет размер после ReDim VBA

Question

Я искал здесь ответ на мою проблему, но все еще не знаю, как ее решить, поэтому я обновляю тему.

У меня есть примитивная функция, которая выполняет поиск в рабочей таблице (столбец A)входные данные для Userform.TextBox1, UserForm.Textbox2 и т. д. Когда определенная запись найдена, ей следует присвоить массиву саму запись и значения из следующих 3 или 4 ячеек из той же строки (каждая строка заканчивается «Конец»),Таким образом, у меня будет массив максимум из 4 столбцов и столько строк, сколько будет найдено записей. Первый цикл Do работает идеально, но при этом увеличивается переменная size (найденные записи), поэтому я увеличиваю строку массива, как я хотел, дает мне ошибку subscript out of range.Я потратил на это целый день, но я не вижу, чего мне не хватает.Вот код:

Sub test()
Dim arr() As Variant
Dim i, size As Integer
Dim back As String
Cells(1, 1).Select
i = 0
size = 0
Do Until ActiveCell.Value = UserForm1.TextBox1.Value
  ActiveCell.Offset(1, 0).Select
Loop
back = ActiveCell.Address
Do Until ActiveCell = "End"
    size = size + 1
    ReDim Preserve arr(1 To size, 1 To 4)
    Do Until ActiveCell.Value = "End"
        i = i + 1
        arr(size, i) = ActiveCell
        ActiveCell.Offset(0, 1).Select
    Loop
Loop
Range(back).Offset(1, 0).Select
Do Until ActiveCell.Value = UserForm1.TextBox2.Value
   ActiveCell.Offset(1, 0).Select
Loop
back = ActiveCell.Address
i = 0
Do Until ActiveCell = "End"
    size = size + 1
    ReDim Preserve arr(1 To size, 1 To 4)      '"Subscript out of range" error occurs here
    Do Until ActiveCell.Value = "End"
        i = i + 1
        arr(size, i) = ActiveCell
        ActiveCell.Offset(0, 1).Select
    Loop
Loop
End Sub

Answer 1

Если вы используете Сохранить ключевое слово в массиве Redim объявление, оно будет только переразмерять последний столбец массива.Вам нужно реорганизовать массив arr ().

Answer 2

Чтобы переформулировать ваш алгоритм:

• Поиск в первом столбце текста в UserForm1.TextBox.Это начальная строка блока
• Каждый блок продолжается до тех пор, пока в первом столбце не появится "End"
• Для каждой строки в блоке вам нужны значенияячейки в этой строке.
• Ячейка, содержащая "End", отмечает конец значений ячеек в этой строке.

Я бы предложил следующие общие улучшения:

• Используйте структуру данных, где вам не нужно управлять количеством элементов, поскольку это очень подвержено ошибкам.Используйте Scripting.Dictionary, ArrayList или VBA Collection.
• . Вам не нужно манипулировать выбранной ячейкой.Определите Range и выполните итерации по ячейкам в Range.

Примерно так:

Dim text1 As String
text1 = "Alfa"
Dim text2 As String
text2 = "Kilo"

Dim results As New ArrayList

Dim rng As Range
Set rng = Worksheets("Sheet1").UsedRange

Dim row As Integer
For row = 1 To rng.Rows.Count
    Dim firstCellText As String
    firstCellText = rng(row, 1)

    'you might store the possible values in a Dictionary and use Dictionary.Exists for this check
    If firstCellText = text1 Or firstCellText = text2 Then

        Dim cellValues As ArrayList
        Set cellValues = New ArrayList 'this has to be on a separate line

        Dim cell As Range
        For Each cell In rng.Rows(row).Cells
            If cell = "End" Then Exit For
            cellValues.Add cell.Value
        Next
        results.Add cellValues
    End If
Next