Bonsoir Dranreb,
Résultat OK, j'ai supprimé les lignes vides par contre j'ai étét obligé de Redim le tableau TS après For Each DR In Gigogne(ColUti(FBase1.[A5😛5]), 1, 10, 2).
1- Comment formater les lignes de Col 1 à col 10 dont je retrouve Total en Col1 ou en Col2 en fond Jaune et gras ?
2-Peut-on optimiser le code ci-dessous ?
Merci encore
KIM
Sub Synthese_ParOP_DPT_Site_GrouperCol_vR312()
'Synthese R3
Dim C As Long, TS(), DCols As Dictionary, TSpl() As String, N As Long, L As Long, _
OP As SsGr, TotOP(7 To 10) As Double, DR As SsGr, TotDR(7 To 10) As Double, SITE As SsGr, _
Détail, Statut As String, Montant As Double, NbG(7 To 11) As Long, TotG(7 To 10)
Dim F As Long, FDest As Worksheet, LMax As Long
For F = FVent1.Index To ThisWorkbook.Worksheets.Count
Set FDest = ThisWorkbook.Worksheets(F): FDest.Name = FDest.CodeName: Next F
F = FVent1.Index - 1
ReDim TS(1 To 1000, 1 To 10)
For C = 1 To 10: TS(1, C) = Choose(C, "DPT", "OP", "SITE", "SUB", _
"", "", "A+D+F", "B+C+G", "E", "Total"): Next C
Set DCols = New Dictionary
For C = 7 To 9: TSpl = Split(TS(1, C), "+")
For N = 0 To UBound(TSpl): DCols(TSpl(N)) = C: Next N, C
' L = 1
For Each DR In Gigogne(ColUti(FBase1.[A5😛5]), 1, 10, 2)
With ThisWorkbook.Worksheets: If F = .Count Then .Item(F).Copy After:=.Item(F)
F = F + 1: Set FDest = .Item(F): End With
FDest.Name = DR.Id
ReDim TS(1 To 1000, 1 To 10)
L = 1
For C = 1 To 10: TS(1, C) = Choose(C, "DPT", "OP", "SITE", "SUB", _
"", "", "A+D+F", "B+C+G", "E", "Total"): Next C
For C = 7 To 10: TotDR(C) = 0: Next C
For Each OP In DR.Co
For C = 7 To 10: TotOP(C) = 0: Next C
LMax = 0
For Each SITE In OP.Co
LMax = LMax + SITE.Count
L = L + 1
TS(L, 1) = DR.Id
TS(L, 2) = OP.Id
TS(L, 3) = SITE.Id
For Each Détail In SITE.Co
Statut = Détail(16): Montant = Détail(14)
If Not DCols.Exists(Statut) Then MsgBox "Statut """ & Statut & """ non prévu.", vbCritical: Exit Sub
C = DCols(Statut)
TS(L, C) = TS(L, C) + Montant: TS(L, 10) = TS(L, 10) + Montant
NbG(C) = NbG(C) + 1: NbG(10) = NbG(10) + 1: Next Détail
For C = 7 To 10: TotOP(C) = TotOP(C) + TS(L, C): Next C, SITE
L = L + 1: TS(L, 2) = "Total " + DR.Id + " - " + OP.Id
For C = 7 To 10: TS(L, C) = TotOP(C): TotDR(C) = TotDR(C) + TotOP(C): Next C, OP
L = L + 1: TS(L, 1) = "Total " + DR.Id
For C = 7 To 10: TS(L, C) = TotDR(C): TotG(C) = TotG(C) + TotDR(C): Next C
L = L + 1: TS(L, 1) = "Nbre Total"
For C = 7 To 10: TS(L, C) = NbG(C): Next C
FDest.Rows(4).Resize(1000000).ClearContents
FDest.[A4].Resize(1000, 10) = TS
For C = 7 To 10: TotG(C) = 0: NbG(C) = 0: Next C
Next DR
End Sub
