在Excel中以编程方式选择其他表单先例或依赖关系 [英] Programmatically select other sheet precedents or dependents in Excel

问题描述

在Excel Ctrl + [或] 有时会直接切换到另一张表，以显示该表中的先例或依赖关系。 p>

我想以编程方式，因为我想要获取选定单元格的先例（或依赖关系）。

Range.Dependents 和 Range.Precedents 有其他问题，但解决方案并没有解决额外的问题。

解决方案

之后一些Google Googling我发现它已经在 2003年中解决了。

但是我使用了这里的代码。

问题是 Dependents 和先例是范围属性，不能引用多个工作表。

该解决方案使用 NavigateArrow 来查找横向折页。

这是我的代码：

  Option Explicit 
 
私有子GetOffSheetDents（ByVal doPrecedants As Boolean）
 
 Dim c As Range 
 Dim results As Range 
 Dim r As Range 
 Dim sheet As Worksheet 
 Dim extra As Boolean 
 
对于每个c在Application.Intersect（ActiveSheet.UsedRange，Selection）
设置r = oneCellDependents（c，doPrecedents）
如果不是r是否然后
如果r.Worksheet是ActiveSheet然后
'跳过
 ElseIf sheet Is Nothing然后
设置sheet = r.Worksheet 
包含结果，r 
 ElseIf不是表单是r.Worksheet然后
如果不额外然后
 extra = True 
 MsgBox多个外部表单& IIf（doPrecedants，先例，赡养人）& 只显示第一张。 
结束如果
 Else 
包含结果，r 
结束如果
结束如果
下一个
 
如果结果是Nothing Then 
 Beep 
 Else 
 results.Worksheet.Activate 
 results.Select 
 End If 
 End Sub 
 
 Sub GetOffSheetDependents（）
 
 GetOffSheetDents False 
 
 End Sub 
 
 Sub GetOffSheetPrecedents（）
 
 GetOffSheetDents True 
 
结束Sub 
 
私有函数Include（ByRef ToUnion As Range，ByVal Value As Range）As Range 
如果ToUnion不是，然后
设置ToUnion = Value 
 Else 
 Set ToUnion = Application.Union（ToUnion，Value）
 End If 
 Set Include = ToUnion 
 End Function 
 
私有函数oneCellDependents（ByVal inRange As Range，Optional doPrecedants As Boolean）As Range 
 
 Dim inAddress As String，returnSelection As Range 
 Dim i As Long，pCount As Long，qCount As Long 
 
如果inRange.Cells .Count<> 1 Then Error.Raise 13 
 
 Rem记住选择
设置returnSelection =选择
 inAddress = fullAddress（inRange）
 
 Application.ScreenUpdating = False 
 with inRange 
 .ShowPrecedents 
 .ShowDependents 
 .NavigateArrow doPrecedents，1 
直到fullAddress（ActiveCell）= inAddress 
 pCount = pCount + 1 
 .NavigateArrow doPrecedents，pCount 
如果ActiveSheet.Name<> returnSelection.Parent.Name然后
 
 Do 
 qCount = qCount + 1 
 .NavigateArrow doPrecedents，pCount，qCount 
包含一个CellDependents，选择
在错误恢复Next 
 .NavigateArrow doPrecedents，pCount，qCount + 1 
如果Err.Number<> 0然后_ 
退出Do 
错误GoTo 0 
循环
错误GoTo 0 
 .NavigateArrow doPrecedents，pCount + 1 
 Else 
包含oneCellDependents，Selection 
 .NavigateArrow doPrecedents，pCount + 1 
 End If 
 Loop 
 .Parent.ClearArrows 
 End with 
 
 Rem返回选择到
与returnSelection 
 .Parent.Activate 
。选择
结束
 Application.ScreenUpdating = True 
 
结束函数
 
私有函数fullAddress（inRange As Range）As String 
 with inRange 
 fullAddress = .Parent.Name& ！ &安培; 。地址
结束
结束功能
  

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

I want that programmatically, because I want to get the precedents (or dependents) of a selection of cells.

Range.Dependents and Range.Precedents have other issues, but the solution there does not solve the extra-sheet issue.

解决方案

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

这篇关于在Excel中以编程方式选择其他表单先例或依赖关系的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！