1

ここに画像の説明を入力

VBA初心者で申し訳ありません。以下の問題を解決するために、トラバース後の例を探しています。列 A のツリーを再帰的にトラバースして、連結ステータスを計算したいと思います。以下の表の例のように、「Real Proj 1」のステータスは A (= 琥珀色) です。「実際のプロジェクト 2 と 3 の両方のステータスは G (緑) です。プログラム B のサブ プロジェクトの 1 つにアンバーが含まれているため、計算されたステータスはアンバー (列 C を参照) である必要があります。または、行 2 の「単純化」の統合ステータスはすべての子 ("Real Proj A"、Program B および C) には、Amber のステータスが少なくとも 1 つ含まれているので、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