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

Question

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

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

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

Answer 1

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

 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

Answer 2

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

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

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

Answer 3

也许是这样的：

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

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

Pass array function into user defined function

excel

vba

unique