1

在此处输入图像描述

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

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
4

0 回答 0