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