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

---

编辑：对我来说，在下面的注释中使用测试值可以正常工作：

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