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

时间:2011-02-02 16:33:03

标签: excel vba

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

在我的第一本练习册的单元格A1中: somebook.xls!Sheet 1中!C2

我想查看somebook.xls的第1页中的单元格C2,了解其(外部)依赖关系,然后递归。

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

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

感谢。

2 个答案:

答案 0 :(得分:0)

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

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

答案 1 :(得分:0)

此答案基于比尔·曼维尔(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