0

Consider the following example: Lets say you want to make a function "JoinIfs" that works just like SUMIFS except instead of adding the values in the SumRange, it concatenates the values in "JoinRange". Is there a way to nest the ParamArray as it seems to be done in SUMIFS?

SUMIFS(sum_range, criteria_range1, criteria1, [criteria_range2, criteria2], ...)

I imagine the declaration should look something like this:

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

But nothing I try seems to compile and there might not be a way to nest ParamArrays. But the existence of functions like SUMIFS and COUNTIFS seems to suggest there might be a way to nest the ParamArrays.

This question duplicates AlexR's question Excel UDF with ParamArray constraint like SUMIFS. But that was posted a few years ago with no response so either the question didn't get enough attention or it was misunderstood.

Edit for clarification: This question is specifically about nesting ParamArrays. I'm not trying to find alternative methods of achieving the outcome of the example above. Imagine nesting ParamArrays on a completely different fictional function like "AverageIfs"

4

2 回答 2

1

As per the documentation for the Function statement and Sub statement, a Function or Sub can only contain 1 ParamArray, and it must be the last argument.

However, you can pass an Array as an Argument to a ParamArray. Furthermore, you can then check how many elements are in the ParamArray, and throw an error if it isn't an even number. For example, this demonstration takes a list of Arrays, and which element in that array to take, and outputs another array with the results:

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

(A list of built-in error codes for Err.Raise can be found here)

于 2020-04-16T16:31:33.807 回答
0

It seems like nesting a ParamArray is not possible.

I was hoping to get a function that looks like Excel's built in functions.

SUMIFS declaration

SUMIFS, for example seems to group pairs of parameters in a very neat way.

Based on the inputs of some users I made the following Function which seems to work quite well.

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

This function makes use of another function SJoin() which I adapted some time ago based on the answer provided by Lun in his answer to How to replicate Excel's TEXTJOIN function in VBA UDF that allows array inputs.

I have adapted this Function to include the use of Numericals, VBA Arrays and Arraylists as well.

    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

Thanks to all who contributed to this question.

于 2020-04-16T21:51:40.063 回答