将数组函数传递给用户定义的函数答案

【问题标题】：Pass array function into user defined function将数组函数传递给用户定义的函数
【发布时间】：2017-10-25 08:26:13
【问题描述】：

我有一个标准的用户定义函数，可以连接所有唯一值。我要做的是在满足条件的范围内执行此功能。

Function ConcatUniq(xRg As Range, xChar As String) As String
'updateby Extendoffice 20151228
    Dim xCell As Range
    Dim xDic As Object
    Set xDic = CreateObject("Scripting.Dictionary")
    For Each xCell In xRg
        xDic(xCell.Value) = Empty
    Next
    ConcatUniq = Join$(xDic.Keys, xChar)
    Set xDic = Nothing
End Function

举个例子：如果我们有以下数据：

A1:A5 = {1,2,2,4,1}

B1:B5 = {"group1", "group1","group1", "group2", "group2"}

C1 = "group1"

现在我想使用 ConcatUniq 函数为 group1 中的所有数字查找唯一值。通常，如果我想执行另一个功能，例如中位数，我会执行以下操作：

=MEDIAN(IF(B1:B5=C1,A1:A5))

使用给出 2 的 cntrl shift enter 激活它（从中创建一个数组函数）。由于某些原因，这不能与用户定义的函数结合使用。

=ConcatUniq(IF(B1:B5=C1,A1:A5)," ")

想要的结果：

1 2

有人知道我该如何解决这个问题吗？

【问题讨论】：

这个IF(B1:B5=C1,A1:A5)," 的输出不是这些:xRg As Range 之一，所以使用Variant 并测试Range 和Array/Variant 然后从那里开始

标签： vba excel unique

【解决方案1】：

您需要使用ParamArray 来容纳从 Excel 的数组公式返回的数组。由于 ParamArray 应该始终是最后一个，所以你的方法签名会改变。

这将在 CTRL + SHIFT + ENTER 上与 =ConcatUniq(" ",IF(B1:B5=C1,A1:A5)) 一起使用

Public Function ConcatUniq(xChar As String, ParamArray args())

    Dim xDic As Object
    Dim xVal

    Set xDic = CreateObject("Scripting.Dictionary")

    For Each xVal In args(0)
        If Not Not xVal Then
        xDic(xVal) = Empty
        End If
    Next

    ConcatUniq = Join$(xDic.Keys, xChar)

End Function

【讨论】：

我仍然认为应该考虑 MacroMan 的评论以适应所有数据输入类型。
L42 所说的，只有在 A1:A5 中有数字时才有效

【解决方案2】：

大概是这样的：

Public Function ConcatUniq(ByVal rangeOrArray As Variant, ByVal xChar As String) As String

    Dim generalArray As Variant
    If IsArray(rangeOrArray) Then
        'operate on it as if was an array
        generalArray = rangeOrArray
    Else
        If TypeName(rangeOrArray) = "Range" Then
            'operate on it as if was a Range
            If rangeOrArray.Cells.Count > 1 Then
                generalArray = rangeOrArray.Value
            Else
                generalArray = Array(rangeOrArray.Value)
            End If
        Else
            'Try to process as if it was a derivative of a value of a single cell range.....
            generalArray = Array(rangeOrArray)
        End If
    End If

    Dim xDic As Object
    Set xDic = CreateObject("Scripting.Dictionary")

    Dim xCell As Variant
    For Each xCell In generalArray
        If xCell <> False Then xDic(xCell) = Empty  ' EDIT - HACKY....
    Next
    ConcatUniq = Join$(xDic.Keys, xChar)

End Function

您可以看到，整个 if-else 块可以分解为一个单独的函数，将工作表输入转换为统一的形式，以便对工作表的值进行操作。

【讨论】：

这几乎可以工作，但这也将值 FALSE 添加到列表中，因此输出 1 2 FALSE
好吧，如果传入的是 False，那么您可能希望根据我在答案中的编辑在 UDF 中将其删除

【解决方案3】：

最简单的解决方案可能是引入一个附加功能。此函数将处理条件并生成一个仅由满足条件的数据组成的数组。试试这样的：

 function condition_check(data1() as integer, data2() as string, condition_value as string) as integer
        number_of_elements = Ubound(data1)
        j = 0
        for i = 0 to number_of_elements
            if data2(i) = condition_value then
               condition_check(j) = data1(i)
               j = j+1
            end if
        next i
end function

【讨论】：