Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, Arg5 As SsGr, TTit(), RngCbl As Range, _
TJoin() As String, j As Long, RngPoliceRg As Range, PfxArg As String, P As Long
TTit = ActiveSheet.[A1:F1].Value
ReDim TR(1 To 100000, 1 To 3)
Set RngCbl = ActiveSheet.[G2].Resize(UBound(TR, 1), 3)
RngCbl.Font.Color = 0
For Each Arg2 In Gigogne(ActiveSheet.[A2:F2], -2, -3, -4, 1, -5)
For Each Arg3 In Arg2.Co
For Each Arg4 In Arg3.Co
For Each Arg5 In Arg4.Co
ReDim TJoin(1 To Arg4.Count): j = 0
For Each Arg1 In Arg4.Co: j = j + 1: TJoin(j) = Arg1.Id: Next Arg1
PfxArg = "?"
For j = 1 To UBound(TJoin)
P = InStr(TJoin(j), "-")
If Left$(TJoin(j), P) = PfxArg Then TJoin(j) = Mid$(TJoin(j), P + 1) Else PfxArg = Left$(TJoin(j), P)
Next j
LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = "'" & Join(TJoin, ".")
LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg4.Somme(5): If Arg4.Somme(5) <= 5 Then TR(LR, 3) = 1
Next Arg5, Arg4, Arg3
LR = LR + 5: Next Arg2
RngCbl.Value = TR
On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
If Err = 0 Then
RngCbl.Offset(, -1).Font.Color = &HFF&
RngCbl.ClearContents: End If