recursion的VBA先例

我有一个Excel电子表格，有很多公式和数据可以跟踪。 我有一个小的macros，可以find一个选定的单元格的先例，但是我喜欢使macrosrecursion，以便我可以find所有的先例。 例如，将焦点设置到单元格并运行此function将突出显示该单元格，然后突出显示该单元格的先例，然后突出显示这些单元格的先例，然后突出显示先例…

我现在遇到的问题是我不确定逃生条件应该是什么。 我遇到了一些无限循环的问题，并不熟悉recursion足以找出一个可靠的解决scheme。

下面是我正在使用的一些代码（正确）find不适用的先例：

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) 

任何帮助表示赞赏。 谢谢

Answer 1

正如我在上面的评论中提到的，这里有一个例子可以在同一张工作表中用于先例。 这会给你一个在其他工作表中find先例的开始。

比方说，我们的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 

产量

示例文件

你可以从这里下载示例文件来修补。 运行macrosSheet1.Sample()

如果你想要的话，你可以为G4创build更多的先例：I4，G10：I10并testing它:)