Макросы в Excel

Sub ПримерОбъединенияМассивов()
    Arr1 = [a5:c10].Value    ' массив размерами 6 * 3
   Arr2 = [a24:c26].Value    ' массив размерами 3 * 3
   Arr3 = [a55:c62].Value    ' массив размерами 8 * 3

    ОбъединённыйМассив12 = CombineArrays(Arr1, Arr2)
    Debug.Print "Количество строк после объединения массивов 1 и 2:   " & _
                UBound(ОбъединённыйМассив12) ' результат: 9 (6+3)


    ОбъединённыйМассив123 = CombineArrays(Arr1, CombineArrays(Arr2, Arr3))
    Debug.Print "Количество строк после объединения массивов 1, 2 и 3:   " & _
                UBound(ОбъединённыйМассив123) ' результат: 17 (6+3+8)

End Sub

Function CombineArrays(Arr1 As Variant, Arr2 As Variant) As Variant
    'функция CombineArrays объединяет 2 двумерных массива ОДИНАКОВОЙ ШИРИНЫ в один массив
   '(второй массив "дописывается" ниже первого, путем добавления строк из второго массива в первый)
   'Функция возвращает массив той же ширины, что и исходные,
   'а вертикальная размерность возвращаемого массива равна сумме количества строк исходных массивов
   '
   'В случае, если один из массивов не задан, функция возвращает другой заданный массив (без изменений)
   'ВНИМАНИЕ: все размерности массивов 1 и 2 должны совпадать (кроме первой размерности - по высоте)
   'Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1)


    ' если один из параметров не является массивом, функция возвращает другой параметр (массив)
   If (Not IsArray(Arr1)) And IsArray(Arr2) Then CombineArrays = Arr2: Exit Function
    If (Not IsArray(Arr2)) And IsArray(Arr1) Then CombineArrays = Arr1: Exit Function
    ' если оба параметра функции не являются массивами
   If (Not IsArray(Arr2)) And (Not IsArray(Arr1)) Then
        Debug.Print "ОШИБКА: Оба переданных значения не являются массивами!"
        CombineArrays = Null: Exit Function
    End If

    ' проверяем совпадение размерностей массивов Arr1 и Arr2
   On Error Resume Next: Err.Clear

    If (LBound(Arr1, 2) <> LBound(Arr2, 2)) Or (UBound(Arr1, 2) <> UBound(Arr2, 2)) Then
        Debug.Print "ОШИБКА: Размерности массивов (по ширине) не совпадают"
        CombineArrays = Null: Exit Function
    End If
    If Err.Number = 9 Then
        Debug.Print "ОШИБКА: Один из массивов не является двумерным!"
        CombineArrays = Null: Exit Function
    End If


    ReDim arr(1 To UBound(Arr1, 1) + UBound(Arr2, 1), LBound(Arr1, 2) To UBound(Arr1, 2))

    For i = 1 To UBound(Arr1, 1)
        For j = LBound(Arr1, 2) To UBound(Arr1, 2)
            arr(i, j) = Arr1(i, j)
        Next
    Next

    For i = 1 To UBound(Arr2, 1)
        For j = LBound(Arr2, 2) To UBound(Arr2, 2)
            arr(i + UBound(Arr1, 1), j) = Arr2(i, j)
        Next
    Next
    CombineArrays = arr    ' возвращаем объединённый массив
End Function