Функция CombineArrays объединяет 2 двумерных массива ОДИНАКОВОЙ ШИРИНЫ в один массив

(второй массив "дописывается" ниже первого, путем добавления строк из второго массива в первый)

Функция возвращает массив той же ширины, что и исходные, а вертикальная размерность возвращаемого массива равна сумме количества строк исходных массивов.

В случае, если один из массивов не задан, функция возвращает другой заданный массив (без изменений)

ВНИМАНИЕ: все размерности массивов 1 и 2 должны совпадать (кроме первой размерности - по высоте)

Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1)

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

• 12435 просмотров