Question

我试图展示相关项目活动的路径。基本上你可以把它想象成有向图。我制作了它的邻接矩阵。

      STA A1.1 A1.2 ...
STA    0   1    0   ... 
A1.1   0   0    1   ...
A1.2   0   0    0   ...
...   ... ...  ...  ...

然后我编写了一个子程序来查找所选活动的前辈，但我真正需要的是从一开始就显示所有相关活动。例如，如果选择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
'---------------------------------

我的问题是是否可以将子程序Findpath更改为递归函数以打印出所有相关活动？

这是完整的邻接矩阵：

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 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 1 END 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

Answer 1

对的简短回答是否可以将子程序Findpath更改为递归函数为是。

但我认为你在想这个。如果我正确理解您的要求，您可以使用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

这会从您的示例数据中返回STA, A1.1, A1.2

如果数据中存在无限链

，您可能需要添加一个检查以突破

excel vba递归函数

1 个答案: