mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Объединение двумерных массивов

Функция 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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Применил Вашу функцию, все отлично работает.
Спасибо, что помогаете и делитесь своими знаниями с другими.
Удачи Вам в Ваших делах!

Андрей, вы вообще в курсе, что такое двумерные массивы?
В теорию вдаваться не буду (об этом в интернете почитаете), а по размерностям постараюсь объяснить:

Примеры объявления двумерного массива размерами 8 строк на 3 столбца:
dim arr(1 to 8, 1 to 3) ' индексы начинаются с 1
или
dim arr(0 to 7, 0 to 2) ' индексы начинаются с 0

Мой макрос понимает только массивы, где индексы начинаются с единицы
(иначе пришлось бы усложнять код)

PS: Когда мы считываем диапазон ячеек в массив, индексы получаемого массива начинаются с единицы:

arr = [a55:c62].Value    ' массив размерами 8 * 3 (с индексами 1 to 8, 1 to 3)

А что значит:
'все размерности массивов 1 и 2
'Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1).
подскажите кто может. буду благодарен.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _           _   _   _               _ 
| |_ ____ | \ | | | |__ __ _ / |
| __| |_ / | \| | | '_ \ / _` | | |
| |_ / / | |\ | | |_) | | (_| | | |
\__| /___| |_| \_| |_.__/ \__, | |_|
|___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.