Вложение ParamArrays при объявлении функций Excel VBA как SUMIFS?

Question

Рассмотрим следующий пример. Допустим, вы хотите создать функцию "JoinIfs", которая работает так же, как SUMIFS, за исключением того, что вместо добавления значений в SumRange она объединяет значения в "JoinRange" , Есть ли способ вложить ParamArray, как это делается в SUMIFS?

SUMIFS (sum_range, crit_range1, критерии1, [crit_range2, критерии2], ...)

Я полагаю, что объявление должно выглядеть примерно так:

Function JoinIfs(JoinRange As Variant, _
                  Delim As String, _
                  IncludeNull As Boolean, _
                  ParamArray CritArray(CriteriaRange As Variant, Criteria As Variant)) As String

Но, похоже, ничего из того, что я пытаюсь сделать, не компилируется и не может быть способа вложения ParamArrays. Но существование таких функций, как SUMIFS и COUNTIFS, по-видимому, предполагает, что может быть способ вложения ParamArrays.

Этот вопрос дублирует вопрос AlexR Excel UDF с ограничением ParamArray, например SUMIFS . Но это было опубликовано через несколько лет go без ответа, поэтому либо на вопрос не было обращено достаточно внимания, либо он был неправильно понят.

Редактировать для уточнения: Этот вопрос конкретно о вложенность ParamArrays . Я не пытаюсь найти альтернативные методы достижения результата в примере выше. Представьте, что вы вложили ParamArrays в совершенно другую вымышленную функцию, например "AverageIfs"

Answer 1

Согласно документации для оператора Function и Sub оператор , Function или Sub может содержать только 1 ParamArray, и он должен быть последним аргументом.

Однако , вы можете передать Array в качестве аргумента ParamArray. Кроме того, вы можете проверить, сколько элементов содержится в ParamArray, и выдать ошибку, если это не четное число. Например, эта демонстрация берет список Arrays и какой элемент в этом массиве, чтобы взять, и выводит другой массив с результатами:

Sub DemonstrateParamArray()
    Dim TestArray As Variant
    TestArray = HasParamArray(Array("First", "Second"), 0)

    MsgBox TestArray(0)

    Dim AnotherArray As Variant

    AnotherArray = Array("Hello", "World")

    TestArray = HasParamArray(AnotherArray, 0, AnotherArray, 1)

    MsgBox Join(TestArray, " ")
End Sub

Function HasParamArray(ParamArray ArgList() As Variant) As Variant
    Dim ArgumentCount As Long, WhichPair As Long, Output() As Variant, WhatElement As Long

    ArgumentCount = 1 + UBound(ArgList) - LBound(ArgList)

    'Only allow Even Numbers!
    If ArgumentCount Mod 2 = 1 Then
        Err.Raise 450 '"Wrong number of arguments or invalid property assignment"
        Exit Function
    End If

    ReDim Output(0 To Int(ArgumentCount / 1) - 1)

    For WhichPair = LBound(ArgList) To ArgumentCount + LBound(ArgList) - 1 Step 2
         WhatElement = ArgumentCount(WhichPair + 1)
        Output(Int(WhichPair / 2)) = ArgumentCount(WhichPair)(WhatElement)
    Next WhichPair

    HasParameterArray = Output
End Function

( Список встроенных кодов ошибок для Err.Raise можно найти здесь )

Answer 2

Кажется, что вложение ParamArray невозможно.

Я надеялся получить функцию, похожую на встроенные функции Excel.

* Например, 1008 *

SUMIFS, по-видимому, очень аккуратно группирует пары параметров.

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

Function SJoinIfs(JoinRange As Variant, Sep As String, IncludeNull As Boolean, ParamArray CritArray() As Variant) As Variant
'Concatenates text based on multple criteria similar to SUMIFS.
'Sizes of ranges CritArray (0, 2, 4 ...) must match size of range JoinRange. CritArray must have an even amount of elements
'Elements of CritArray (1, 3, 5 ...) must be single values
    Set JoinList = CreateObject("System.Collections.Arraylist")
    'Set FinalList = CreateObject("System.Collections.Arraylist")
    For Each DataPoint In JoinRange
        JoinList.Add (CStr(DataPoint))
    Next
    JoinArray = JoinList.ToArray
    CriteriaCount = UBound(CritArray) + 1
    If CriteriaCount Mod 2 = 0 Then
        CriteriaSetCount = Int(CriteriaCount / 2)
        Set CriteriaLists = CreateObject("System.Collections.Arraylist")
        Set CriteriaList = CreateObject("System.Collections.Arraylist")
        Set MatchList = CreateObject("System.Collections.Arraylist")
        For a = 0 To CriteriaSetCount - 1
            CriteriaList.Clear
            For Each CriteriaTest In CritArray(2 * a)
                CriteriaList.Add (CStr(CriteriaTest))
            Next
            If CriteriaList.count <> JoinList.count Then 'Ranges are different sizes
                SJoinIfs = CVErr(xlErrRef)
                Exit Function
            End If
            MatchList.Add (CStr(CritArray((2 * a) + 1)))
            CriteriaLists.Add (CriteriaList.ToArray)
        Next
        JoinList.Clear
        For a = 0 To UBound(JoinArray)
            AllMatch = True
            For b = 0 To MatchList.count - 1
                AllMatch = (MatchList(b) = CriteriaLists(b)(a)) And AllMatch
            Next
            If AllMatch Then JoinList.Add (JoinArray(a))
        Next
        SJoinIfs = SJoin(Sep, IncludeNull, JoinList)
    Else 'Criteria Array Size is not even
        SJoinIfs = CVErr(xlErrRef)
        Exit Function
    End If
End Function

Эта функция использует другую функцию SJoin (), которую я некоторое время адаптировал go на основе ответа, предоставленного Lun в его ответе на Как копировать Excel Функция TEXTJOIN в VBA UDF, которая позволяет вводить массивы .

. Я адаптировал эту функцию, чтобы включить использование чисел, массивов VBA и массивов.

    On Error Resume Next
    'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
    'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
    Dim OutStr As String 'the output string
    Dim i, j, k, l As Integer 'counters
    Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays

    'Go through each item of TxtRng(),  depending on the item type, transform and put it into FinArray()
    i = 0 'the counter for TxtRng
    j = 0 'the counter for FinArr
    k = 0: l = 0 'the counters for the case of array from Excel array formula
    Do While i < UBound(TxtRng) + 1
        If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
            ReDim Preserve FinArr(0 To j)
            FinArr(j) = "blah"
            FinArr(j) = TxtRng(i)
            j = j + 1
        ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
            For Each element In TxtRng(i)
                ReDim Preserve FinArr(0 To j)
                FinArr(j) = element
                j = j + 1
            Next
        ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
             For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
                For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
                    ReDim Preserve FinArr(0 To j)
                    FinArr(j) = TxtRng(0)(k, l)
                    j = j + 1
                Next
             Next
        Else
            TJoin = CVErr(xlErrValue)
            Exit Function
        End If
    i = i + 1
    Loop

    'Put each element of the new array into the join string
    For i = LBound(FinArr) To UBound(FinArr)
        If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
        OutStr = OutStr & FinArr(i) & Sep
        End If
    Next
     TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator

End Function

Спасибо всем кто способствовал этому вопросу.