Excel UDF Filter Range

问题:

I have a function that takes a range of values as input (just a column) as well as some threshold. I would like to return a range that is filtered to include all values from the original range that are greater than the threshold. I have the following code:

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

The issue is that once a number is below the threshold, other numbers after that one that are above the threshold do not get added to the range.

For example:

Threshold - 2

Numbers -

3
4
1
5

It will loop through adding 3 and 4 but 5 will not be added. I end up getting a #value error. But I get no error and it works fine if I only enter the range - 3, 4 or the range - 3, 4, 1.

回答1:

It's looks like the UDF doesn't like non-contiguous ranges being written back to an array.

One way around it is to re-write the UDF like below. It assumes the output array is only in column but does allow multiple column input.

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

回答2:

ooo got there first but I've typed it out now so I may as well post it. This version will return as a column vector of the correct size.

If nothing matches then #N/A is returned in a 1 by 1 array (this is consistent with the normal behaviour of an array function when there are insufficient values to fill the array)

edit2: updated function thanks to comments from 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

---

edit: works OK for me with the test values in the comment below:

I'm sure you know this but don't include the { or } characters when entering the array formula - Excel adds them in after you've hit Ctrl-Shift-Enter