Excel VBA: Функция объединения массивов

[alex]

Здравствуйте!
Столкнулся с такой проблемой. В формуле Excel ТЕНДЕНЦИЯ используются массивы из сплошных диапазонов ячеек Известные_значения_y  и Известные_значения_x. Например: из диапазона (А1:А3) получаем массив {1; 2; 3}
Есть необходимость использования массивов из раздельных диапазонов. Например: из диапазонов (А1:А3; А5:А6) получить массив {1; 2; 3; 4; 5}.
Создавать именованные массивы не подходит.

Возможно ли в VBA написать функцию, выдающую массив данных из раздельных диапазонов с последующим использованием в формуле Excel ТЕНДЕНЦИЯ. Напимер: =ТЕНДЕНЦИЯ(Функция_У;Функция_Х;A4)

Такой вариант не проходит.

Function Функция_Х(ParamArray Данные())
  Dim Element As Variant
  Dim X
  For Each Element In Данные
    If X = 0 Then
        GetResult = Element.Value
    Else
        GetResult = GetResult & ";" & Element.Value
    End If
    X = X + 1
  Next
  Функция_Х = "{" & GetResult & "}"
End Function

Формула Excel ТЕНДЕНЦИЯ выдает ошибку #ЗНАЧ!

[Администратор]

В файле есть пользовательская функция myFun, в неё передавайте два эксель-фрагмента. Функция будет их объединять в один vba-массив и затем в функцию Тенденция будет подставляться массив, а не диапазон ячеек.

[alex]

Количество диапазонов в одном массиве может быть разным.
Возможно ли через ParamArray получить результат?

[Администратор]

Да, получилось сделать:

Пользовательская функция

Function myFun(ParamArray rngs())

    Dim rng, cel, CellsCount As Long
    Dim res(), arr(), i As Long, r As Long
   
   
    '1. Подсчёт, сколько ячеек выбрано, чтобы знать, сколько ячеек создать в массиве.
    For Each rng In rngs()
        CellsCount = CellsCount + rng.Cells.Count
    Next rng
   
    '2. Создание ячеек в массиве-результате.
    ReDim res(1 To CellsCount, 1 To 1)
   
    '3. Копирование данных из выбранных ячеек в массив.
    For Each rng In rngs()
   
        '1) Копирование сначала во вспомогательный массив, чтобы каждую ячейку не просматривать.
            ' Это актуально, если ячеек много. Если мало, то можно без вспомогательного массива.
        If rng.Cells.Count = 1 Then
            ReDim arr(1 To 1, 1 To 1)
            arr(1, 1) = rng.Value
        Else
            arr() = rng.Value
        End If
       
        '2) Копирование данных из вспомогательного массива в массив-результат.
        For Each cel In arr()
            r = r + 1
            res(r, 1) = cel
        Next cel
       
    Next rng
   
    '4. Копирование массива в переменную-функцию.
    myFun = res()
   
End Function

[свернуть]

[alex]

Спасибо!