声明 SUMIFS 等 Excel VBA 函数时嵌套 ParamArrays？

Posted 2023-04-13

【中文标题】声明 SUMIFS 等 Excel VBA 函数时嵌套 ParamArrays？

【英文标题】：Nesting ParamArrays when declaring Excel VBA functions like SUMIFS?

【发布时间】：2020-04-16 12:40:03

【问题描述】：

考虑下面的例子：假设你想创建一个函数“JoinIfs”，它的工作原理与SUMIFS 一样，除了不是添加SumRange 中的值，而是连接“JoinRange”中的值.有没有办法像在SUMIFS 中那样嵌套ParamArray？

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

我想声明应该是这样的：

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 with ParamArray constraint like SUMIFS 重复。但那是几年前发布的，没有任何回应，所以这个问题要么没有得到足够的关注，要么被误解了。

编辑澄清：这个问题专门关于嵌套 ParamArrays。我不是试图找到实现上述示例结果的替代方法。想象一下将 ParamArrays 嵌套在一个完全不同的虚构函数上，比如“AverageIfs”

【问题讨论】：

只使用 TEXTJOIN...如果您的 Excel 版本不支持它，SO 上有 UDF 版本。

见：***.com/questions/56858571/…

或者这个：***.com/questions/39258111/…

@BigBen 已经做了一个非常好的连接函数Function SJoin(Sep As String, IncludeNull As Boolean, ParamArray TxtRng() As Variant) As String，它基于我在网上找到的 sn-p 连接多种数据类型。我要检查的功能是多个标准。例如，将 Supplier="Walmart" 和 City="Houston" 与 vbCrLf 作为分隔符的行中的所有“购物项目”值连接起来将为休斯顿沃尔玛销售代表创建一个购物清单。此外，我想避免使用数组公式。

很公平 - 但您将受限于使用 ParamArray，我认为您对链接到的问题采取了类似的方法。

【参考方案1】：

根据Function statement 和Sub statement 的文档，Function 或Sub 只能包含1 个ParamArray，并且它必须是最后一个参数。

但是，您可以将Array 作为参数传递给ParamArray。此外，您还可以检查ParamArray 中有多少元素，如果不是偶数则抛出错误。例如，此演示采用 Arrays 列表，以及该数组中要采用的 element，并输出另一个带有结果的数组：

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 的内置错误代码列表here）

【讨论】：

感谢您的回答。遗憾的是，它不能以与内置函数完全相同的方式完成。像你一样添加错误代码是一个不错的选择。我选择将 Excel 用户界面错误输出而不是 VBA 错误代码放入函数中（请参阅下面的答案）。你知道有什么方法可以在同一个功能中同时提供这两种功能吗？

【参考方案2】：

似乎无法嵌套 ParamArray。

我希望得到一个看起来像 Excel 内置函数的函数。

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()，我根据Lun 在他对How to replicate Excel's TEXTJOIN function in VBA UDF that allows array inputs 的回答中提供的答案改编了该函数。

我已经调整了这个函数，以包括对数值、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

感谢所有为这个问题做出贡献的人。