Excel UDF过滤器范围

Question

我有一个函数，它将一系列值作为输入（只是一列）以及一些阈值。我想返回一个过滤的范围，以包括原始范围中大于阈值的所有值。我有以下代码：

Public Function FilterGreaterThan(Rng As Range, Limit As Double) As Range

Dim Cell As Range
Dim ResultRange As Range

For Each Cell In Rng
    If Abs(Cell.Value) >= Limit Then
        If ResultRange Is Nothing Then
            Set ResultRange = Cell
        Else
            Set ResultRange = Union(ResultRange, Cell)
        End If
    End If    
Next
Set FilterGreaterThan = ResultRange
End Function

问题是，一旦某个数字低于阈值，那么在该数字之后的其他数字高于阈值就不会被添加到该范围内。

例如：

Threshold - 2

Numbers -

3
4
1
5

它将循环添加3和4但不会添加5。我最终得到#value错误。但我没有错误，如果我只输入范围 - 3,4或范围 - 3,4,1，它就可以正常工作。

Answer 1

看起来UDF不喜欢将非连续范围写回数组。

解决这个问题的一种方法是重写UDF，如下所示。它假设输出数组仅在列中，但允许多列输入。

Option Explicit

Public Function FilterGreaterThan(Rng As Range, Limit As Double) As Variant

Dim Cell As Range
Dim WriteArray() As Variant
Dim i As Long
Dim cellVal As Variant
Dim CountLimit As Long

CountLimit = WorksheetFunction.CountIf(Rng, ">=" & Limit)
ReDim WriteArray(1 To CountLimit, 1 To 1) 'change if more than 1 column
For Each Cell In Rng

    cellVal = Cell.Value
    If Abs(cellVal) >= Limit Then
            i = i + 1 'change if more than 1 column
            WriteArray(i, 1) = cellVal 'change if more than 1 column
    End If
Next
FilterGreaterThan = WriteArray
End Function

Answer 2

ooo首先到达那里，但我现在已经输入了它，所以我也可以发布它。此版本将作为正确大小的列向量返回。

如果没有匹配，则在1 x 1数组中返回#N / A（当数值不足以填充数组时，这与数组函数的正常行为一致）

edit2：感谢ooo

的评论更新了功能

Public Function FilterGreaterThan(Rng As Range, Limit As Double) As Variant()

Dim inputCell As Range ' each cell we read from
Dim resultCount As Integer ' number of matching cells found
Dim resultValue() As Variant ' array of cell values

resultCount = 0
ReDim resultValue(1 To 1, 1 To Rng.Cells.Count)

For Each inputCell In Rng
    If Abs(inputCell.Value) >= Limit Then
        resultCount = resultCount + 1
        resultValue(1, resultCount) = inputCell.Value
    End If
Next inputCell

' Output array must be two-dimensional and we can only
' ReDim Preserve the last dimension
If (resultCount > 0) Then
    ReDim Preserve resultValue(1 To 1, 1 To resultCount)
Else
    resultValue(1, 1) = CVErr(xlErrNA)
    ReDim Preserve resultValue(1 To 1, 1 To 1)
End If

' Transpose the results to produce a column rather than a row
resultValue = Application.WorksheetFunction.Transpose(resultValue)

FilterGreaterThan = resultValue

End Function

---

编辑：对我来说可以使用下面评论中的测试值：

我确定您知道这一点，但在输入数组公式时不要包含{或}个字符 - Excel会在您点击Ctrl后添加它们-Shift - 输入