excel vba 递归函数
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/13759590/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
excel vba recursive function
提问by Stephen Younger
I am trying to show a path of related project activities. Basically you can think of it as a directed graph. I made an adjacency matrix of it.
我试图展示相关项目活动的路径。基本上，您可以将其视为有向图。我做了一个邻接矩阵。
STA A1.1 A1.2 ...
STA 0 1 0 ...
A1.1 0 0 1 ...
A1.2 0 0 0 ...
... ... ... ... ...
Then I wrote a subroutine to find the predecessors of a selected activity but what I would really need is to show all related activities from the start. For the example if A1.2 is selected it should print out [STA, A1.1, A1.2]. If the end result is selected where all activities lead too all activities should be printed out in the correct order. The different paths could be separated like this [STA, A1.1, A1.2, ... END],[STA, A2.1, A2.2, ... END],[STA, A3.1, ...] My code so far which prints out only the predecesoors of a chosen activity:
然后我编写了一个子程序来查找选定活动的前身，但我真正需要的是从一开始就显示所有相关活动。例如，如果选择 A1.2，则应打印出 [STA, A1.1, A1.2]。如果最终结果被选择为所有活动都领先，则所有活动都应以正确的顺序打印出来。不同的路径可以像这样分开 [STA, A1.1, A1.2, ... END],[STA, A2.1, A2.2, ... END],[STA, A3.1, ... ..] 到目前为止，我的代码仅打印出所选活动的前身：
'---------------------------------
Sub RunThings()
Application.ScreenUpdating = False
Call UserInput
Application.ScreenUpdating = True
End Sub
'---------------------------------
Sub UserInput()
Dim iReply As Variant
iReply = Application.InputBox(Prompt:="Please enter activity name", Title:="FIND ACTIVITY PATH", Type:=2)
'MsgBox (iReply)
If iReply = False Then
Exit Sub
Else 'They cancelled (VbCancel)
If iReply <> "" Then
Call Findpath(CStr(iReply))
End If
End If
Exit Sub
End Sub
'---------------------------------
Function FindRowCol(term As String, row As Boolean)
Dim SearchRange As Range
Dim FindRC As Range
If row = False Then
Set SearchRange = Range("A1", Range("T1").End(xlUp))
Else
Set SearchRange = Range("A1", Range("A65536").End(xlUp))
End If
Set FindRC = SearchRange.Find(term, LookIn:=xlValues, lookat:=xlWhole)
If row = False Then
FindRowCol = FindRC.Column
Else
FindRowCol = FindRC.row
End If
End Function
'---------------------------------
Sub Findpath(activity As String)
Application.ScreenUpdating = False
ActCol = FindRowCol(activity, False)
For i = 2 To 65536
If Cells(i, 1).Value = "" Then
LastRow = Cells(i, 1).row - 1
Exit For
End If
Next i
Dim Predecessors() As Variant
Dim Counter As Integer
Counter = 0
For j = 1 To LastRow
If Cells(j, ActCol).Value = 1 Then
Counter = Counter + 1
End If
Next j
ReDim Predecessors(1 To Counter)
Insert = 1
For j = 1 To LastRow
If Cells(j, ActCol).Value = 1 Then
Predecessors(Insert) = Cells(j, 1).Value
Insert = Insert + 1
End If
Next j
Dim CurrAct As String
For k = LBound(Predecessors) To UBound(Predecessors)
CurrAct = CStr(Predecessors(k))
MsgBox (CurrAct)
Next k
Application.ScreenUpdating = True
End Sub
'---------------------------------
My question would be is it possible to change the subroutine Findpath into a recursive function to print out all related activities?
我的问题是是否可以将子程序 Findpath 更改为递归函数以打印出所有相关活动？
This is the complete adjacency matrix:
这是完整的邻接矩阵：
STA A1.1 A1.2 A1.3 A1.4 A1.5 A2.1 A2.2 A2.3 A2.4 A2.5 A3.1 A4.1 A4.2 A4.3 A4.4 A4.5 A5.1 END STA 0 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 A1.1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.2 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.3 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.4 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A2.1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 A2.2 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 A2.3 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 A2.4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A2.5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A3.1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 A4.1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 A4.2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 A4.3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 A4.4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A4.5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A5.1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 END 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
STA A1.1 A1.2 A1.3 A1.4 A1.5 A2.1 A2.2 A2.3 A2.4 A2.5 A3.1 A4.1 A4.2 A4.3 A4.4 A4.5 A5 .1 结束 STA 0 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 A1.1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.2 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.3 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.4 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 A1.5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A2.1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 A2.2 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 A2。3 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 A2.4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A2.5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A3.1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 A4.1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 A4.2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 A4.3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 A4.4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A4.5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 A5。1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 END 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
回答by chris neilsen
Short answer to is it possible to change the subroutine Findpath into a recursive functionis Yes.
是否可以将子例程 Findpath 更改为递归函数的简短回答是是。
But I think your are over thinking this. If I understand your requirement correctly, you can do it with a Do Loop, like this
但我认为你想多了。如果我正确理解您的要求，您可以Do Loop像这样使用
Sub Demo()
Findpath ActiveSheet, "A1.2"
End Sub
Sub Findpath(sh As Worksheet, activity As String)
Dim rHeader1 As Range
Dim rHeader2 As Range
Dim x, y
Dim nxtActivity As String
Dim sPath As String
With sh
Set rHeader1 = .Range(.Cells(1, 2), .Cells(1, 2).End(xlToRight))
Set rHeader2 = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
nxtActivity = activity
sPath = activity
Do
x = Application.Match(nxtActivity, rHeader1, 0)
If IsError(x) Then
Exit Do
Else
y = Application.Match(1, rHeader2.Offset(0, CLng(x)), 0)
If IsError(y) Then
Exit Do
Else
nxtActivity = Application.Index(rHeader2, CLng(y))
sPath = nxtActivity & ", " & sPath
End If
End If
Loop
End With
MsgBox sPath
End Sub
This returns STA, A1.1, A1.2from your sample data
这STA, A1.1, A1.2从您的示例数据返回
You might want to add a check to break out if an endless chain is present in the data
如果数据中存在无限链，您可能需要添加一个检查以打破
