excel - 在 Excel 中以编程方式选择其他工作表先例或从属工作表

Question

在 Excel 中，Ctrl+[ 或 ] 有时会直接切换到另一个工作表以显示该工作表中的先例或从属项。

我希望以编程方式实现这一点，因为我想获取所选单元格的先例(或依赖项)。

Range.Dependents 和 Range.Precedents 有 other issues ，但是那里的解决方案并没有解决额外的纸张问题。

Answer 1

马克做了一些不错的工作，但这个宏完全没有转到“同一张纸上的凹痕”，并且当“多个纸上有凹痕时失败”，因为无法从多个纸单元格中创建选择。

我个人需要所有这些功能来替换用于跳转到先例和依赖项的“Ctrl + [”和“Ctrl + ]”快速快捷方式功能。不幸的是，这些快捷键在国际键盘上完全无法使用，这些方括号埋在 AltGr(右 Alt)组合下，Excel 不允许 Ctrl+AltGr+8 和 Ctrl+AltGr+8 给出相同的结果，而且还有无法重新映射默认快捷键。

因此，我稍微改进了 Mark 的代码来修复这些问题，并从代码中删除了弹出消息，因为如果我无法选择所有“凹痕”，我应该知道自己，但我希望该功能能够顺利运行，而无需我始终单击“确定”。因此，该函数只是跳转到公式中第一个链接的工作表。

我希望这对其他人也有用。

唯一仍然困扰我的是，虽然 Application.ScreenUpdating = False 避免在工作表和工作簿中跳转，但箭头仍然不断闪烁。有什么办法可以避免这种情况吗？

Option Explicit

Private Sub GetOffSheetDents(ByVal doPrecedents As Boolean)
'Main function, calling for separate function to find links to all cells to one of the input cells. Works for finding precedents for a whole selection (group of cells)
'doPrecedents is TRUE, if we are searching for precedents and FALSE, if looking for dependents
Dim InputCell As Range
Dim results As Range
Dim r As Range
Dim sheet As Worksheet

Application.ScreenUpdating = False

For Each InputCell In Application.Intersect(ActiveSheet.UsedRange, Selection)
'Cycle to go over all initially selected cells. If only one cell selected, then happens only once.
    Set r = oneCellDependents(InputCell, doPrecedents)
    ' r is resulting cells from each iteration of input cell to the function.
    If Not r Is Nothing Then      'if there were precedents/dependents
        If sheet Is Nothing Then  'if this is the first time.
            Set sheet = r.Worksheet
            Include results, r
        ElseIf Not sheet Is r.Worksheet Then 'if new precedent/dependent is on another worksheet, don't add to selection (gets lost)
        Else
            Include results, r
        End If
    End If
Next
Application.ScreenUpdating = True

If results Is Nothing Then
    Beep
Else
    results.Worksheet.Activate
    results.Select
End If
End Sub

Sub GetOffSheetDependents()
'Function defines, if we are looking for Dependents (False) or Precedents (True)
GetOffSheetDents False

End Sub

Sub GetOffSheetPrecedents()
'Function defines, if we are looking for Dependents (False) or Precedents (True)
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
    ElseIf Value.Worksheet Is ToUnion.Worksheet Then 'if new precedent/dependent is on the same worksheet, then add to selection
            'if new precedent/dependent is on another worksheet, don't add to selection (gets lost)
        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
'Function finds dependents for one of the selected cells. Happens only once, if initially only one cell selected.
Dim inAddress As String, returnSelection As Range
Dim i As Long, pCount As Long, qCount As Long
Application.ScreenUpdating = False
If inRange.Cells.Count <> 1 Then Error.Raise 13 'seems to check, that only one cell is handled, but does not seem to be necessary step.

'remember selection
Set returnSelection = Selection ' to keep initial selection for GetOffSheetDents function.
inAddress = fullAddress(inRange) ' takes address of starting cell what is analyzed.
pCount = 1

With inRange   'all functions apply to this initial cell.
    .ShowPrecedents
    .ShowDependents
    .NavigateArrow doPrecedents, 1 ' go to first precedent (if first argument is true)/dependent. But why required?
    Do Until fullAddress(ActiveCell) = inAddress
        .NavigateArrow doPrecedents, pCount 'go to first precedent, then second etc.
        If ActiveSheet.Name <> returnSelection.Parent.Name Then ' checks, if the precedent is NOT on the same sheet

            Do
                qCount = qCount + 1   'qCount follows external references, if arrow is external reference arrow.
                .NavigateArrow doPrecedents, pCount, qCount 'go to first exteranl precedent, then second etc.
                Include oneCellDependents, Selection
                On Error Resume Next
                .NavigateArrow doPrecedents, pCount, qCount + 1 'could remove this step and check for error before Include?
                If Err.Number <> 0 Then Exit Do
                On Error GoTo 0  ' not sure if this is used, since if there is error, then already Exit Do in previous step.
            Loop
            On Error GoTo 0 'not sure, if necessary, since just asked in loop.
        Else  ' if precedent IS ON the same sheet.
            Include oneCellDependents, Selection
        End If
        pCount = pCount + 1
        .NavigateArrow doPrecedents, pCount
    Loop
    .Parent.ClearArrows
End With

'return selection to where it was
With returnSelection
    .Parent.Activate
    .Select
End With

End Function

Private Function fullAddress(inRange As Range) As String
'Function takes a full address with sheet name

With inRange
    fullAddress = .Parent.Name & "!" & .Address
End With
End Function