使用 Excel VBA 在外部电子表格中追踪先例

Question

我目前正在尝试跟踪一组复杂的 Excel 电子表格的依赖关系。 我理想的最终目标是树结构，从我的第一个电子表格开始。 但是，我不想包含子电子表格的所有依赖项，只包含原始电子表格引用的单元格。 例如：

在我的第一个工作簿的单元格 A1 中：somebook.xls!Sheet1!C2

我想查看 somebook.xls 表 1 中的单元格 C2 的（外部）依赖项，然后递归。

目前我正在使用 LinkInfo 获取外部依赖项列表，使用 Find 进行搜索，并且我正在努力使用 vbscript 的原始正则表达式功能来尝试从我找到的单元格中提取地址。 这不是一个绝妙的做事方式。

有谁知道 Excel 是否会告诉您引用了外部电子表格中的哪些单元格？ 如果没有，还有其他可能有用的工具吗？

谢谢。

Answer 1

您会发现，Excel的内置支持是有限的，并且可能会非常令人沮丧。

根据我的经验，我发现http://www.aivosto.com/中的一些工具很有用； Visustin v6对于与代码相关的审核/处理特别有用。

Answer 2

这个答案是基于比尔·曼维尔（Bill Manville）多年以来的宏。 该宏仍然有效，但是我将其分解为功能，以提供更大的灵活性和可重用性。 我主要增加的功能是仅查找外部依赖项的功能，以及对先例和依赖项的扩展。 我还添加了对自定义宏unhideAll的调用； 这对我来说是必要的，因为在隐藏的工作表中找不到依赖项。

'Module for examining depedencies to/from a sheet from/to other sheets
Option Explicit

Sub showExternalDependents()
    Dim deps As Collection
    Set deps = findExternalDependents(ActiveCell)
    Call showDents(deps, True, "External Dependents: ")
End Sub

Sub showExternalPrecedents()
    Dim precs As Collection
    Set precs = findExternalPrecedents(ActiveCell)
    Call showDents(precs, True, "External Precedents: ")
End Sub

'external determines whether or not to print out the absolute address including workbook & worksheet
Sub showDents(dents As Collection, external As Boolean, header As String)
    Dim dent As Variant
    Dim stMsg As String
    stMsg = ""
    For Each dent In dents
        stMsg = stMsg & vbNewLine & dent.Address(external:=external)
    Next dent
    MsgBox header & stMsg
End Sub

Function findPrecedents(rng As Range) As Collection
    Set findPrecedents = findDents(rng, True)
End Function

Function findDependents(rng As Range) As Collection
    Set findDependents = findDents(rng, False)
End Function

Function findExternalPrecedents(rng As Range) As Collection
    Set findExternalPrecedents = findExternalDents(rng, True)
End Function

Function findExternalDependents(rng As Range) As Collection
    Set findExternalDependents = findExternalDents(rng, False)
End Function

'Gives back only the dependencies that are not on the same sheet as rng
Function findExternalDents(rng As Range, precDir As Boolean) As Collection
    Dim dents As New Collection
    Dim dent As Range
    Dim d As Variant
    Dim ws As Worksheet
    Set ws = rng.Worksheet
    For Each d In findDents(rng, precDir)
        Set dent = d
        With dent
            If Not (.Worksheet.name = ws.name) Then _
                dents.Add Item:=dent
        End With
    Next d
    Set findExternalDents = dents
End Function

'this procedure finds the cells which are the direct precedents/dependents of the active cell
'If precDir is true, then we look for precedents, else we look for dependents
Function findDents(rng As Range, precDir As Boolean) As Collection
    'Need to unhide sheets for external dependencies or the navigate arrow won't work
    Call mUnhideAll
    Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
    Dim dents As New Collection
    Dim bNewArrow As Boolean
    'Appliciation.ScreenUpdating = False
    If precDir Then
        ActiveCell.showPrecedents
    Else
        ActiveCell.ShowDependents
    End If
    Set rLast = rng
    iArrowNum = 1
    iLinkNum = 1
    bNewArrow = True
    Do
        Do
            Application.Goto rLast
            On Error Resume Next
            ActiveCell.NavigateArrow TowardPrecedent:=precDir, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
            If Err.Number > 0 Then Exit Do
            On Error GoTo 0
            If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
            bNewArrow = False
            dents.Add Item:=Selection
            iLinkNum = iLinkNum + 1 ' try another link
        Loop
        If bNewArrow Then Exit Do
        iLinkNum = 1
        bNewArrow = True
        iArrowNum = iArrowNum + 1 'try another arrow
    Loop
    rLast.Parent.ClearArrows
    Application.Goto rLast
    Set findDents = dents
End Function

Sub mUnhideAll()
'
' mUnhideAll Macro
'
    ' Unhide All
    Dim ws As Worksheet
    For Each ws In Worksheets
    ws.Visible = True
    Next

    'Sheets("Sprint Schedule Worksheet").Visible = False

End Sub

Answer 3

这是 Colm Bhandal 的 findDents 和 findExternalDents 的简化版本。 它假定所有工作表都可见并且箭头在使用前已清除。

Function findDents(rCell As Range, bPrec As Boolean) As Collection
'Return all direct precedents (bPrec=True) or dependents (bPrec=False) of rCell
    Dim sAddr As String, nLink As Integer, nArrow As Integer
    Const bAbs As Boolean = False, bExt As Boolean = True
    Set findDents = New Collection
    If bPrec Then
        rCell.showPrecedents                ' even if rCell has no formula
    Else
        rCell.showDependents
    End If
    On Error Resume Next                    ' ignore errors
    sAddr = rCell.Address(bAbs, bAbs, xlA1, bExt)
    nArrow = 1
    Do
        nLink = 1
        Do
            rCell.NavigateArrow bPrec, nArrow, nLink
            If ActiveCell.Address(bAbs, bAbs, xlA1, bExt) = sAddr Then Exit Do
            findDents.Add Selection         ' possibly more than one cell
            nLink = nLink + 1
        Loop
        If nLink = 1 Then Exit Do
        nArrow = nArrow + 1
    Loop
    On Error GoTo 0
    If bPrec Then
        rCell.showPrecedents Remove:=True
    Else
        rCell.showDependents Remove:=True
    End If
End Function

Function findExternalDents(rCell As Range, bPrec As Boolean) As Collection
'Return ...Dents that are NOT in the same workbook and worksheet as rCell
    Dim rDent As Range, wsName As String, wbName As String
    With rCell.Worksheet: wsName = .Name: wbName = .Parent.Name: End With
    Set findExternalDents = New Collection
    For Each rDent In findDents(rCell, bPrec)
        If rDent.Worksheet.Name <> wsName Or rDent.Worksheet.Parent.Name <> wbName Then findExternalDents.Add Item:=rDent
    Next rDent
End Function

您可能希望修改它以使用 SortedList 而不是 Collection。 在这种情况下，改变

findDents.Add Selection

到

findDents.Add Selection.Address(bAbs, bAbs, xlA1, bExt), Null