none
DirectDependentsプロパティを用いた再帰関数について RRS feed

  • 質問

  • お世話になります.下記の再帰関数を作成しているところですが,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
    • 編集済み じふ 2013年7月28日 11:24
    2013年7月28日 8:08