0

配列数式を使用してセルの範囲を条件に照らしてチェックし、列オフセットを返すために、VBA 関数を作成しました。これは基本的に、合計を返す代わりに、合計されたはずのセル範囲を返す Sumif です。

私が遭遇している問題は、ワークシート内と別の関数内で呼び出されたときにコードの実行が異なることです。具体的には、.SpecialCells は必要なときに範囲を制限しません。たとえば、コードでは、数式または定数を持つセルのみで比較を実行します。これは、別のマクロまたは即時ウィンドウから呼び出したときに実行される計算を制限するためにうまく機能しますが、シートに数式として入力すると、まったく制限しません(列全体を比較として指定した場合、列内のほとんどのセルが空白であっても、1048576個のセルすべてを通過します)

重要なコードは次のとおりです。

 For Each CheckCell In Check.SpecialCells(xlCellTypeConstants)

Check as Range("A:A") の場合、これは理想的には定数を含む 132 個のセルに対して実行されますが、代わりに列全体が実行されます。

これをより賢明に機能させる方法はありますか?コードの残りの部分は、必要なものに対して非常にうまく機能します。この式が使用されているすべてのセルの列全体を計算するのに数秒を費やしたくありません.

完全な機能:

Function RangeIf(returnColumn As Range, Check As Range, Condition As String) As Range
    'Exit Function
    Dim Operator As Integer, HasOperator As Boolean, TheColumn As String, CheckCell As Range, Passed As Boolean, ReturnRange As Range
    HasOperator = True
    Operator = 0
    TheColumn = Mid(returnColumn.Cells(1, 1).Address, 2)
    TheColumn = "$" & Mid(TheColumn, 1, InStr(1, TheColumn, "$"))
    While HasOperator
        Select Case Mid(Condition, 1, 1)
            Case "<"
                Operator = Operator Or 1
                Condition = Mid(Condition, 2)
            Case ">"
                Operator = Operator Or 2
                Condition = Mid(Condition, 2)
            Case "="
                Operator = Operator Or 4
                Condition = Mid(Condition, 2)
            Case Else
                HasOperator = False
        End Select
    Wend
    For Each CheckCell In Intersect(Check, Check.Parent.UsedRange).Cells
        Passed = False
        'UpdateStatusBar "Processing Cell: " & CheckCell.Address
            Select Case Operator
                Case 0, 4    'No op or Equals
                    If CheckCell.Value = Condition Then Passed = True
                Case 1    ' Less than
                    If CheckCell.Value < Condition Then Passed = True
                Case 2    ' Greater than
                    If CheckCell.Value > Condition Then Passed = True
                Case 3    ' Not
                    If CheckCell.Value <> Condition Then Passed = True
                Case 5    ' Less or Equal
                    If CheckCell.Value <= Condition Then Passed = True
                Case 6    ' Greater or Equal
                    If CheckCell.Value >= Condition Then Passed = True
            End Select
            If Passed Then
                If Not ReturnRange Is Nothing Then
                    Set ReturnRange = Union(ReturnRange, Range(TheColumn & CheckCell.Row))
                Else
                    Set ReturnRange = Range(TheColumn & CheckCell.Row)
                End If
            End If
    Next CheckCell

    Set RangeIf = ReturnRange
End Function
4

1 に答える 1