配列数式を使用してセルの範囲を条件に照らしてチェックし、列オフセットを返すために、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