2

値の範囲を入力 (列のみ) といくつかのしきい値として受け取る関数があります。しきい値を超える元の範囲のすべての値を含むようにフィルター処理された範囲を返したいと思います。次のコードがあります。

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 のみを入力すると正常に動作します。

4

2 に答える 2

2

UDFは、連続していない範囲が配列に書き戻されることを好まないようです。

それを回避する1つの方法は、以下のように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
于 2012-09-12T21:57:18.683 に答える
2

oooが最初にそこにたどり着きましたが、今入力したので、投稿することもできます。このバージョンは、正しいサイズの列ベクトルとして返されます。

一致するものがない場合、#N/A が 1 行 1 列の配列で返されます (これは、配列を埋めるのに十分な値がない場合の配列関数の通常の動作と一致しています)。

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

編集：以下のコメントのテスト値で問題なく動作します：

FilterGreaterThan UDF が正しく機能していることを示す Excel ファイル

あなたはこれを知っていると確信していますが、配列数式を入力するときに{または}文字を含めないでください - ExcelはCtrl-Shift-Enterを押した後にそれらを追加します

于 2012-09-12T22:36:19.603 に答える