Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Добавление элементов в динамический двумерный массив из драгого массива
 
#1
01.05.2021 11:44:38
Всем привет!

Никак не могу разобраться с двумерными массивами. Как заполнять двумерный массив с сохранением предыдущих элементов?
Есть код:
Код
Sub Пример()
Dim i, Counter, myArr
Dim Criterial, RowTarget As Range, Result
Criterial = Cells(7, 1)
Set RowTarget = Range("a10")
myArr = Range("h1:j5")
For i = LBound(myArr, 1) To UBound(myArr, 1)
    If myArr(i, 1) = Criterial Then
                Counter = Counter + 1
                If Counter = 1 Then
                    ReDim Result(0, 1)
                Else
                    ReDim Result(UBound(Result), UBound(Result) + 1)

                End If
                Result(UBound(Result), UBound(Result)) = myArr(i, 2)
                Result(UBound(Result), UBound(Result) + 1) = myArr(i, 3)
    End If
Next i
RowTarget.Resize(1, UBound(Result) + 1) = Result

End Sub
Запутался с redim preserve.

Пример во вложении.
Всем большое спасибо!
 
 
 
#2
01.05.2021 11:59:16
artemkau88, http://perfect-excel.ru/publ/excel/makrosy_i_programmy_vba/massivy_v_vba/7-1-0-74#link_1
но вообще не понятно что вы хотите получить в результате!)
Код
Option Explicit

Sub Ïðèìåð()
Dim i, myArr, k As Long
Dim Criterial, RowTarget As Range, Result
Criterial = Cells(7, 1)
Set RowTarget = Range("a10")
myArr = Range("h1:j5")
ReDim Result(1 To UBound(myArr), 1 To 2): k = 1
For i = LBound(myArr, 1) To UBound(myArr, 1)
    If myArr(i, 1) = Criterial Then
        Result(k, 1) = myArr(i, 2)
        Result(k, 2) = myArr(i, 3)
        k = k + 1
    End If
Next i
RowTarget.Resize(UBound(Result), 2) = Result
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
01.05.2021 12:07:48
тут главное прочитать зелёные комментарии

Код
Sub Пример()
    Dim i As Long, Counter As Long, myArr
    Dim Criterial As String, RowTarget As Range, Result
    
    Criterial = Cells(7, 1)
    Set RowTarget = Range("A10")
    myArr = Range("H1:J5")
    ReDim Result(1 To UBound(myArr, 1), 1 To 2) 'вот тут задаём размер точно такой же как и myArr (как бы если все будут ИВАНОВ) и в ширину 2 столбца, но начиная с единицы и у строки и у столбца
    'очень важное - массив не должен иметь нулевой номер строки или столбца, т.е. надо делать Redim Result (1 to миллион), а не Redim Result (0 to миллион) - т.к. Excel не имеет нулевой строки или столбца
    For i = LBound(myArr, 1) To UBound(myArr, 1)
        If myArr(i, 1) = Criterial Then
            Counter = Counter + 1 'если нашли Иванова, то увеличиваем счётчик на 1
            Result(Counter, 1) = myArr(i, 2) 'в первый столец Result записываем число
            Result(Counter, 2) = myArr(i, 3) 'во второй столбец Result записываем группу
        End If
    Next i
    'выгружаем массив на лист - Result не должен начинаться с нулевой первой размерности, а только с единицы - у Excel нет нулевой строки или столбца, есть 1,2,3 и т.д.
    'Counter - это кол-во заполненных строк в Result (хотя мы и определили сперва его размерность больше), но на лист будем выгружать только нужное кол-во строк, которы мы заполнили
    'UBound(Result, 2) - это кол-во столбцов у Result (хотя можно поставить просто цифру 2, т.к. мы знаем, что у Result только 2 столбца)
    RowTarget.Resize(Counter, UBound(Result, 2)).Value = Result
    'можно выгружать и полностью весь Result
    'RowTarget.Resize(UBound(Result, 1), UBound(Result, 2)).Value = Result
End Sub
Изменено: New - 01.05.2021 12:18:55
 
 
 
#4
01.05.2021 12:08:14
redim preserve позволяет изменить только последнюю размерность массива. В случае двухмерного массива это количество столбцов. Количество строк изменить нельзя.
 
 
 
Страницы: 1
Наверх