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

时间:2017-10-25 08:26:14

标签: excel vba excel-vba unique

我有一个标准的用户定义函数,用于汇总所有唯一值。我想要做的是在满足条件的范围内执行此功能。

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)) 

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

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

期望的结果:

1 2

有人知道如何解决这个问题吗?

3 个答案:

答案 0 :(得分:2)

您需要使用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

答案 1 :(得分:1)

也许是这样的:

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-elses块可以被分解为一个单独的函数,用于将工作表输入转换为统一表单,以便对工作表的值进行操作。

答案 2 :(得分:0)

最简单的解决方案可能是引入一个额外的功能。此函数将处理该条件,并将生成仅包含满足条件的数据的数组。 尝试这样的事情:

 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