Programmatically select other sheet precedents or dependents in Excel

前端 未结 3 1551
我在风中等你
我在风中等你 2021-02-09 18:01

In Excel Ctrl+[ or ] will sometimes directly switch to another sheet to show the precedents or dependents in that sheet.

I want that pro

3条回答
  •  傲寒
    傲寒 (楼主)
    2021-02-09 19:01

    After a fair bit of Googling I found it was solved in 2003.

    But I used the code from here.

    The problem is that Dependents and Precedents are Range properties, which can't refer to multiple worksheets.

    The solution uses NavigateArrow to locate the cross-sheet 'dents.

    Here's my code:

    Option Explicit
    
    Private Sub GetOffSheetDents(ByVal doPrecedents As Boolean)
    
    Dim c As Range
    Dim results As Range
    Dim r As Range
    Dim sheet As Worksheet
    Dim extra As Boolean
    
    For Each c In Application.Intersect(ActiveSheet.UsedRange, Selection)
        Set r = oneCellDependents(c, doPrecedents)
        If Not r Is Nothing Then
            If r.Worksheet Is ActiveSheet Then
                ' skip it
            ElseIf sheet Is Nothing Then
                Set sheet = r.Worksheet
                Include results, r
            ElseIf Not sheet Is r.Worksheet Then
                If Not extra Then
                    extra = True
                    MsgBox "More than one external sheet in " & IIf(doPrecedents, "Precedents", "Dependents") & ". Only displaying first sheet."
                End If
            Else
                Include results, r
            End If
        End If
    Next
    
    If results Is Nothing Then
        Beep
    Else
        results.Worksheet.Activate
        results.Select
    End If
    End Sub
    
    Sub GetOffSheetDependents()
    
    GetOffSheetDents False
    
    End Sub
    
    Sub GetOffSheetPrecedents()
    
    GetOffSheetDents True
    
    End Sub
    
    Private Function Include(ByRef ToUnion As Range, ByVal Value As Range) As Range
    If ToUnion Is Nothing Then
        Set ToUnion = Value
    Else
        Set ToUnion = Application.Union(ToUnion, Value)
    End If
    Set Include = ToUnion
    End Function
    
    Private Function oneCellDependents(ByVal inRange As Range, Optional doPrecedents As Boolean) As Range
    
    Dim inAddress As String, returnSelection As Range
    Dim i As Long, pCount As Long, qCount As Long
    
    If inRange.Cells.Count <> 1 Then Error.Raise 13
    
    Rem remember selection
    Set returnSelection = Selection
    inAddress = fullAddress(inRange)
    
    Application.ScreenUpdating = False
    With inRange
        .ShowPrecedents
        .ShowDependents
        .NavigateArrow doPrecedents, 1
        Do Until fullAddress(ActiveCell) = inAddress
            pCount = pCount + 1
            .NavigateArrow doPrecedents, pCount
            If ActiveSheet.Name <> returnSelection.Parent.Name Then
    
                Do
                    qCount = qCount + 1
                    .NavigateArrow doPrecedents, pCount, qCount
                    Include oneCellDependents, Selection
                    On Error Resume Next
                    .NavigateArrow doPrecedents, pCount, qCount + 1
                    If Err.Number <> 0 Then _
                        Exit Do
                    On Error GoTo 0
                Loop
                On Error GoTo 0
                .NavigateArrow doPrecedents, pCount + 1
            Else
                Include oneCellDependents, Selection
                .NavigateArrow doPrecedents, pCount + 1
            End If
        Loop
        .Parent.ClearArrows
    End With
    
    Rem return selection to where it was
    With returnSelection
        .Parent.Activate
        .Select
    End With
    Application.ScreenUpdating = True
    
    End Function
    
    Private Function fullAddress(inRange As Range) As String
    With inRange
        fullAddress = .Parent.Name & "!" & .Address
    End With
    End Function
    

提交回复
热议问题