'アクティブセルを参照しているセルの配列を作成する関数

'INDIRECT関数で参照しているセルは検出できません。

Option Explicit

Function GetDependents(ByRef rangeArray() As Range) As Integer
    Dim book1 As Workbook, sheet1 As Worksheet, range1 As Range
    Dim rangeCount As Integer
    Dim selfAddress As String, a1Address As String
    Dim i As Integer, j As Integer
    Dim r As Range

    On Error GoTo err_1

    Set book1 = ActiveWorkbook
    Set sheet1 = ActiveSheet
    Set range1 = ActiveCell
    selfAddress = ActiveCell.Address(external:=True)
    a1Address = ActiveSheet.Cells(1, 1).Address(external:=True)

    '参照トレース矢印を表示する
    ActiveSheet.ClearArrows
    ActiveCell.ShowDependents

    i = 1
    rangeCount = 0

    Do While True

        '元のセルを選択する
        book1.Activate
        sheet1.Select
        range1.Select

        '参照しているセルへジャンプする
        Set r = ActiveCell.NavigateArrow( _
            towardPrecedent:=False, arrowNumber:=i)

        'セル移動しなかったら終了する
        If r.Address(external:=True) = selfAddress Then Exit Do

        'セルを配列へ追加する
        rangeCount = rangeCount + 1
        ReDim Preserve rangeArray(1 To rangeCount)
        Set rangeArray(rangeCount) = r

        '別のシート上のセルの場合
        If ActiveSheet.Cells(1, 1).Address(external:=True) <> a1Address Then
            j = 2
            Do While True

                '元のセルを選択する
                book1.Activate
                sheet1.Select
                range1.Select

                '参照しているセルへジャンプする
                Set r = Nothing
                On Error Resume Next
                Set r = ActiveCell.NavigateArrow( _
                    towardPrecedent:=False, arrowNumber:=i, _
                    linkNumber:=j)
                On Error GoTo err_1

                'エラーが発生したらループを終了する
                If r Is Nothing Then Exit Do

                '参照しているセルを配列へ追加する
                rangeCount = rangeCount + 1
                ReDim Preserve rangeArray(1 To rangeCount)
                Set rangeArray(rangeCount) = r
                j = j + 1
            Loop
        End If
        i = i + 1
    Loop

    '元のセルを選択する
    book1.Activate
    sheet1.Select
    range1.Select

    '参照トレース矢印をクリアする
    sheet1.ClearArrows

    '結果のセルの数を返す
    GetDependents = rangeCount
    
    Exit Function
err_1:
    If Not (sheet1 Is Nothing) Then sheet1.ClearArrows
    GetDependents = -1
End Function

'Sheet1!A1を参照しているセルの配列を作成する例
Sub Test()
    Dim rangeArray() As Range
    Dim i As Integer, rangeCount As Integer

    Sheets("Sheet1").Select
    Range("A1").Select
    Application.ScreenUpdating = False
    rangeCount = GetDependents(rangeArray())
    Application.ScreenUpdating = True
    If rangeCount > 0 Then
        For i = 1 To rangeCount
            MsgBox rangeArray(i).Address(external:=True)
        Next
    ElseIf rangeCount = 0 Then
        MsgBox "アクティブセルを参照しているセルはありません。"
    Else
        MsgBox "エラーが発生しました。"
    End If
End Sub