お世話になります.下記の再帰関数を作成しているところですが,rangeオブジェクトが見つからずエラーになっています.ご教授いただければと質問いたします.
Function FindFirstPrecedents(ByRef Sh As Worksheet) As Range
Dim i As Long
Dim tmp As Range
i = 0
On Error Resume Next
For Each tmp In Sh.UsedRange
If tmp.HasFormula Then
If CheckEqualRange(tmp.DirectPrecedents, tmp.Precedents) Then
If i = 0 Then
Set FindFirstPrecedents = tmp.DirectPrecedents
Else
Set FindFirstPrecedents = Application.Union(FindFirstPrecedents, tmp.DirectPrecedents)
End If
i = i + 1
End If
End If
Next tmp
On Error GoTo 0
End Function
Function TraceDependents(ByRef Rng As Range) As Range
Dim tmp As Range
Dim i As Long
i = 0
On Error Resume Next
For Each tmp In Rng
If Not tmp.DirectDependents Is Nothing Then
If i = 0 Then
Set TraceDependents = TraceDependents(tmp.DirectDependents)
Else
Set TraceDependents = Application.Union(TraceDependents, TraceDependents(tmp.DirectDependents))
End If
i = i + 1
End If
Next tmp
On Error GoTo 0
End Function
Function CheckEqualRange(ByRef Rng1 As Range, ByRef Rng2 As Range) As Boolean
Dim UnionRange As Range
Dim IntersectRange As Range
Dim tmp As Range
CheckEqualRange = False
Set UnionRange = Application.Union(Rng1, Rng2)
Set IntersectRange = Application.Intersect(Rng1, Rng2)
If UnionRange.Cells.Count = IntersectRange.Cells.Count Then
CheckEqualRange = True
End If
End Function
一つ目の関数はワークシート中にある数式の中で最初の参照元を探し出すもので,2つ目の関数は参照元のセルからDirectDependentsプロパティを1つずつ辿っていく関数なのですが,
Set TraceDependents = TraceDependents(tmp.DirectDependents)
の部分でrangeオブジェクトが取得できていません.この部分,参照先のセル数が不定なので再帰関数にするのが良いかと作成したのですが・・・
よろしくお願いいたします.
P.S.以下の関数の定義が抜けてましたので追記しました.
CheckEqualRange