递归VBA前置依赖项

Question

我有一个包含许多公式和数据的Excel电子表格，我需要跟踪这些内容。我编写了一个小的宏来查找所选单元格的前导单元格，但我想要将这个宏递归处理，以便我可以找到所有的前导单元格。例如，将焦点设置到一个单元格并运行此函数将会突出显示该单元格，并突出显示其前导单元格，然后再突出显示那些单元格的前导单元格，以此类推。

目前我遇到的问题是不确定递归的结束条件应该是什么。我已经遇到了一些无限循环的问题，而且我对递归不够熟悉，无法找出一个可靠的解决方案。

以下是一些代码，我正在使用它（正确地）查找最初的前导单元格：

Sub FindClosedWbReferences(inRange As Range)
Rem fills the collection With closed precedents parsed from the formula String
Dim testString As String, returnStr As String, remnantStr As String
testString = inRange.Formula
testString = RemoveTextInDoubleQuotes(testString): Rem New line
Set ClosedWbRefs = New Collection
Do
    returnStr = NextClosedWbRefStr(testString, remnantStr)
    ClosedWbRefs.Add Item:=returnStr, Key:=CStr(ClosedWbRefs.count)
    testString = remnantStr
    inRange.Select
    inRange.Interior.ColorIndex = 36

Loop Until returnStr = vbNullString

ClosedWbRefs.Remove ClosedWbRefs.count
End Sub

这是从类似于以下的主函数中调用的：

 If homeCell.HasFormula Then
    Set OtherWbRefs = New Collection: CountOfClosedWb = 0
    Set SameWbOtherSheetRefs = New Collection
    Set SameWbSameSheetRefs = New Collection

    Rem find closed precedents from formula String
    Call FindClosedWbReferences(homeCell)

非常感谢您的支持。谢谢。

在IT技术方面，任何帮助都是令人赞赏的。

- Jingles177

---

很好的问题，加上代码示例。不幸的是，我无法提供帮助。 - David Zemens

你希望我们能提供什么具体的帮助呢？目前问题不是很明显。 - RBarryYoung

范围对象已经有一个“Precedents”属性，它返回前置列表。从您的不完整代码清单中无法确定您还想要完成什么其他任务。 - A. Webb

目前，代码将获取活动单元格的前导项并更改其颜色，以便我可以轻松识别它们。我想要的是，在此发生后，获取原始活动单元格生成的前导项，然后查找这些前导项的前导项。我假设递归是解决此问题的最佳方法。 - Jingles177

@Jingles177：我可以给你展示一个在同一工作表中完整循环前置的示例。这有帮助吗？ - Siddharth Rout

Answer 1

如上面我的评论中所提到的，以下是一个在同一工作表中查找先例的示例。这将为您寻找其他工作表中的先例提供一个起点。

假设我们的Excel文件看起来像这样（在结尾处提供了示例文件链接）。

Cell A6 has the formula : =B6
Cell B6 has the formula : =C5+C7
Cell C5 has the formula : =D3+D4+D5
Cell C7 has the formula : =D7+D8+D9
'
' And so on. Cells, D4, D5, D8, D9, F3, G3, F9
' G9, G4:I4, G10:I10 do not have any formulas  

我从这里获取了代码，并进一步修改以满足我的需求。

请查看此代码。

Dim rw As Long, col As Long
Dim ws As Worksheet
Dim fRange As Range

Sub Sample()
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> Clear cell for output
    ws.Rows("20:" & ws.Rows.Count).Clear

    '~~> Select First Cell
    Set fRange = ws.Range("A6")

    '~~> Set Row for Writing
    rw = 20

    FindPrecedents fRange
End Sub

Sub FindPrecedents(Rng As Range)
    ' written by Bill Manville
    ' With edits from PaulS
    ' With further edits by Me 14 Sept 2013
    ' this procedure finds the cells which are the direct precedents of the active cell
    Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
    Dim stMsg As String
    Dim bNewArrow As Boolean

    Application.ScreenUpdating = False
    Rng.ShowPrecedents
    Set rLast = Rng
    iArrowNum = 1
    iLinkNum = 1
    bNewArrow = True

    col = 1

    ws.Cells(rw, col).Value = Rng.Address

    col = col + 1

    Do
        Do
            Application.Goto rLast

            On Error Resume Next
            ActiveCell.NavigateArrow TowardPrecedent:=True, 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

            ws.Cells(rw, col).Value = Selection.Address
            col = col + 1

            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

    '~~> Write Output
    If Len(Trim(ws.Cells(rw, 2).Value)) <> 0 Then
        With ws
            '~~> Find Last column in that row
            lcol = .Cells(rw, .Columns.Count).End(xlToLeft).Column

            j = rw + 1

            For i = 2 To lcol
                .Cells(j, 1).Value = .Cells(rw, i)
                j = j + 1
            Next i
        End With
    End If

    rw = rw + 1

    '~~> Here is where I am looping again
    If Len(Trim(ws.Cells(rw, 1).Value)) <> 0 Then
        FindPrecedents Range(ws.Cells(rw, 1).Value)
    End If
End Sub

输出

示例文件

您可以从这里下载示例文件进行实验。运行宏Sheet1.Sample()

如果您愿意，可以为G4：I4、G10：I10创建更多的先例并进行测试 :)

- Siddharth Rout