使用Excel VBA跟踪外部电子表格中的先例

使用Excel VBA跟踪外部电子表格中的先例,excel,vba,Excel,Vba,我目前正在尝试跟踪一组复杂Excel电子表格的相关性。我理想的最终目标是一个树形结构,从我的第一个电子表格开始。但是,我不想包括子电子表格的所有依赖项,只包括原始电子表格引用的单元格的依赖项。例如: 在我的第一份工作簿的A1单元格中: somebook.xls!第一张!C2 我想查看somebook.xls的表1中的单元格C2的(外部)依赖项,然后递归 目前,我正在使用LinkInfo获取外部依赖项列表,使用Find进行搜索,并且我正在努力使用vbscript的原始正则表达式功能来尝试从我找到的

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

在我的第一份工作簿的A1单元格中: somebook.xls!第一张!C2

我想查看somebook.xls的表1中的单元格C2的(外部)依赖项,然后递归

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

有人知道Excel是否会告诉您正在引用外部电子表格中的哪些单元格吗?如果没有,还有其他可能有用的工具吗


谢谢。

正如您所发现的,Excel的内置支持是有限的,可能会非常令人沮丧


根据我的经验,我从中发现了一些有用的工具;Visustin v6对于与代码相关的审核/处理特别有用。

这个答案基于多年前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

这取决于你需要多普遍,这是相当困难的。请看关于这个问题的评论:谢谢你的提醒-我不认为它需要那么一般,所以希望我能让它发挥作用。谢谢帕特里克,我不认为这正是我想要的。我感兴趣的是电子表格中的链接,而不是任何附加的代码,我更感兴趣的是如何做到这一点,而不是购买工具。但是谢谢你的提示。很公平……我希望你能找到你想要的