'Numero de colonne
Const Phase As Byte = 2
Const ColOption As Byte = 5
Const Chef As Byte = 6
Const Directeur As Byte = 7
Const Developpeur As Byte = 8
Const Cout As Byte = 9
Const MotClef = "Phase"
'nom des feuilles
Const NomF1$ = "Global"
Const NomF2$ = "Développement"
Dim T, V
Sub Princ()
Dim Res(), Temp
Dim I&, J&, K&, X&, Y&
Init
Temp = RecupDoublons(T, 2)
For I = LBound(T) To UBound(T)
For Y = LBound(Temp) To UBound(Temp)
If InStr(1, T(I, Phase), Temp(Y)) > 0 Then 'on teste dans la colonne 2 si on a phase contenu dans la chaine
K = K + 2
'on ne connait pas le nombre de phase=> Construtction du tableau à l'envers
ReDim Preserve Res(1 To UBound(V) + 1, 1 To K * 2)
End If
While InStr(1, T(I, Phase), Temp(Y)) > 0
For X = LBound(V) To UBound(V)
If X = 0 Then
Res(X + 1, K - 1) = T(I, V(X))
Res((X + 1), K) = "OPTIONS"
Else
Res(X + 1, K - 1) = IIf(T(I, ColOption) = "Oui", Res(X + 1, K - 1), Res(X + 1, K - 1) + T(I, V(X)))
Res((X + 1), K) = IIf(T(I, ColOption) = "Oui", T(I, V(X)) + Res((X + 1), K), Res((X + 1), K))
End If
Next X
I = I + 1
If I > UBound(T) Then Exit For
Wend
Next Y
Next I
Temp = InverseTab(Res, 1)
With Sheets(NomF1)
[A5].Resize(UBound(Temp), UBound(Temp, 2)) = Temp
End With
End Sub
Sub Init()
With Sheets(NomF2)
T = Range(.[A5], .Cells(.[A65536].End(xlUp).Row, Cout))
End With
V = Array(Phase, Chef, Directeur, Developpeur, Cout)
End Sub
Function InverseTab(T, Optional Base As Byte = 0) 'Zon
Dim Temp(), I&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function
Function RecupDoublons(T, ByVal ColT As Byte) 'Zon
Dim I&, J&, Tablo As New Collection, Temp()
For I = LBound(T, 1) To UBound(T, 1)
On Error Resume Next
Tablo.Add T(I, ColT), CStr(T(I, ColT))
If Err = 0 Then
ReDim Preserve Temp(J)
Temp(J) = T(I, ColT)
J = J + 1
End If
Next I
RecupDoublons = Temp
End Function