在VBA中进行遍历递归以计算合并状态

Question

我很抱歉，因为我是VBA的新手。我正在寻找一个后遍历示例来解决以下问题。我想以递归方式遍历A列中的树来计算合并状态。如下面的示例表中“Real Proj 1”具有状态A（=琥珀色）。 “Real Proj 2和3都有状态G（绿色）。因为程序B的一个子项目包含Amber，它的计算状态应该是Amber（见C列）。或者第2行的”简化“的合并状态是琥珀和它的所有孩子一样（“Real Proj A”，程序B和C）至少包含一个琥珀状态。

A列中的值包含缩进，即第3行的“程序A”具有缩进级别= 1，第6行的“Real Proj 2”具有缩进级别= 3。 任何有关如何使用递归在VBA中实现此功能的帮助将不胜感激。 谢谢， 克里斯

这是我的解决方案。希望这也有助于其他人。 最好， 克里斯

Sub TestStatus()
    Call PopulateStatus(2)
End Sub

Sub PopulateStatus(rowIndex As Integer)
    Dim level As Integer
    Dim children() As Integer
    Dim child As Integer
    Dim existingStatus As String
    Dim calculatedStatus As String
    Dim counter As Integer
    Dim aggregatedRow As Integer


    If (hasChildren(rowIndex)) Then
        aggregatedRow = rowIndex
        children = getChildren(rowIndex)

        ' Do something with the children
        For counter = LBound(children) To UBound(children)
            child = children(counter)
            Call PopulateStatus(child)
        Next counter

        'Write aggregated status of all children to column B
        calculatedStatus = getStatus(children)
        Cells(aggregatedRow, 2).Value = calculatedStatus
    Else
        existingStatus = Cells(rowIndex, 2).Value
        ' Check if we are last in children
        If (Cells(rowIndex, 1).IndentLevel > Cells(rowIndex + 1, 1).IndentLevel) Then
            'Cells(aggregatedRow, 2).Value = calculatedStatus
        End If

    End If

End Sub



Function getStatus(ByRef myArray() As Integer) As String
    Dim resultStatus As String
    Dim currentStatus As String
    Dim counter As Integer
    resultStatus = "G"

    For counter = 0 To UBound(myArray)
        currentStatus = Cells(myArray(counter), 2).Value

        If currentStatus = "R" Or resultStatus = "R" Then
            calculateStatus = "R"
            Exit Function
        End If

        If currentStatus = "A" Then
            resultStatus = "A"
        End If

        If currentStatus = "G" And resultStatus = "A" Then
            resultStatus = "A"
        End If
    Next
    getStatus = resultStatus

End Function



Function getChildren(rowIndex As Integer) As Variant
    Dim children() As Integer
    Dim myIndLevel As Integer
    Dim newIndLevel As Integer
    Dim counter As Integer
    Dim count As Integer
    myIndLevel = Cells(rowIndex, 1).IndentLevel
    count = 0
    For counter = rowIndex + 1 To 14
        newIndLevel = Cells(counter, 1).IndentLevel
        If (newIndLevel = myIndLevel + 1 And newIndLevel <> myIndLevel) Then
            ReDim Preserve children(count) As Integer
            children(count) = counter
            rowIndex = rowIndex + 1
            count = count + 1
        End If
    Next
    getChildren = children
End Function



Function hasChildren(myRow As Integer)
    Dim indLevel As Integer
    Dim newLevel As Integer
    indLevel = Cells(myRow, 1).IndentLevel
    newLevel = Cells(myRow + 1, 1).IndentLevel

    If newLevel > indLevel Then
        hasChildren = True
        Exit Function
    End If
    hasChildren = False
End Function