Dim TTit(), TInt(), TRes(), RngCbl As Range, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, Arg6 As SsGr, Arg7 As SsGr, _
TS1() As String, TJoin() As String, J As Long, TS2() As String, P As Long, Nom As String, L As Long, Dico As Dictionary, TCoul(), C As Long, Detail
TTit = ActiveSheet.[A1:G1].Value
' Set Dico = DicInvent(ActiveSheet.[A2:F2], 6, 4)
Set Dico = DicInvent(ActiveSheet.[A2:F2], 7, 1)
' ReDim TRes(1 To 10000, 1 To 4 + Dico.Count)
ReDim TRes(1 To 10000, 1 To 3)
Set RngCbl = ActiveSheet.[H1].Resize(UBound(TRes, 1), UBound(TRes, 2))
' VerserEntetes TRes, Dico
TCoul = Dico.Keys: L = 1
RngCbl.Font.Color = 0
For Each Arg2 In Gigogne(Null, -2, -3, -4, 1)
For Each Arg3 In Arg2.Co
For Each Arg4 In Arg3.Co
ReDim TJoin(1 To Arg4.Count): J = 0: ReDim TS1(-1 To -1)
For Each Arg1 In Arg4.Co
TS2 = Split(Arg1.Id, "-")
For P = 0 To UBound(TS2) - 1: TS2(P) = TS2(P) & "-": Next P
For P = 0 To UBound(TS1): If P >= UBound(TS2) Then Exit For
If TS2(P) <> TS1(P) Then Exit For
Next P
Nom = "": While P <= UBound(TS2): Nom = Nom & TS2(P): P = P + 1: Wend
J = J + 1: TJoin(J) = Nom: TS1 = TS2: Next Arg1
L = L + 1: TRes(L, 1) = TTit(1, 1): TRes(L, 2) = Join(TJoin, ".")
L = L + 1: TRes(L, 1) = TTit(1, 2): TRes(L, 2) = Arg2.Id: If Arg2.Id > 200 Then TRes(L, 3) = 1
L = L + 1: TRes(L, 1) = TTit(1, 3): TRes(L, 2) = Arg3.Id: If Arg3.Id > 25 Then TRes(L, 3) = 1
L = L + 1: TRes(L, 1) = TTit(1, 4): TRes(L, 2) = Arg4.Id: If Arg4.Id = 2150 Then TRes(L, 3) = 1
' TRes(L, 3) = TTit(1, 5)
TRes(L + 1, 1) = TTit(1, 5)
For Each Arg1 In Arg4.Co
For Each Detail In Arg1.Co
' C = Dico(Detail(6)): TRes(L, C) = TRes(L, C) + Detail(5)
C = L + Dico(Detail(6)): TRes(C, 2) = TRes(C, 2) + Detail(5)
' Next Detail, Arg1, Arg4, Arg3
Next Detail, Arg1
For C = LBound(TCoul) To UBound(TCoul)
L = L + 1: TRes(L, 3) = TCoul(C)
Next C, Arg4, Arg3
For Each Arg7 In Arg4.Co
For Each Detail In Arg1.Co
' C = Dico(Detail(6)): TRes(L, C) = TRes(L, C) + Detail(5)
C = L + Dico(Detail(7)): TRes(C, 2) = TRes(C, 2)
' Next Detail, Arg1, Arg4, Arg3
Next Detail, Arg1
For C = LBound(TCoul) To UBound(TCoul)
L = L + 1: TRes(L, 3) = TCoul(C)
Next C, Arg4, Arg3
L = L + 5: Next Arg2
RngCbl.Value = TRes
On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants, 1)
If Err = 0 Then
RngCbl.Offset(, -1).Font.Color = &HFF&
RngCbl.ClearContents: End If