Private Sub Worksheet_Activate()
With Worksheets("SYNTHESE")
Range("A:t").Select 'à préciser
ActiveWindow.Zoom = True
Range("B4").Select
End With
Dim PlgSyn As Range, TSyn(), C&, TDon(), DicTT As New Dictionary, LE&, LS&, L&
TSyn = [A3:K3].Value
For C = 5 To 11: DicTT(TSyn(1, C)) = C: Next C
Set PlgSyn = Intersect([A6:K1000000], UsedRange)
On Error Resume Next
Do: Me.Comments(1).Delete: Loop Until Err
On Error GoTo 0
TSyn = PlgSyn.Resize(, 4).Value
ReDim Preserve TSyn(1 To UBound(TSyn, 1), 1 To 11)
TDon = [Table2].Value
LS = 1
For LE = 1 To UBound(TDon, 1)
If LE > 1 Then If TDon(LE, 18) < TDon(LE - 1, 18) Then MsgBox "Date déclassée dans TDon", _
vbCritical, "Synthèse": Application.Goto [Table2].Cells(LE, 18): Exit Sub
For L = LS + 1 To UBound(TSyn) - 1
If TSyn(L, 2) < TSyn(LS, 2) Then MsgBox "Date déclassée dans TSyn", _
vbCritical, "Synthèse": Application.Goto PlgSyn.Cells(L, 2): Exit Sub
If TSyn(L, 2) > TDon(LE, 18) Then Exit For
LS = L: Next L
If DicTT.Exists(TDon(LE, 26)) Then
C = DicTT(TDon(LE, 26))
TSyn(LS, C) = TSyn(LS, C) + TDon(LE, 25)
If TDon(LE, 25) <> "" Then
ModifierCommentaire PlgSyn(LS, C), TDon(LE, 6) & ": " & Format$(TDon(LE, 25), "0.00") & " €"
End If
Else: MsgBox """" & TDon(LE, 26) & """ non prévu dans les titres.", _
vbCritical, "Synthèse": Application.Goto [Table2].Cells(LE, 26): Exit Sub: End If
Next LE
PlgSyn = TSyn
PlgSyn.Cells(UBound(TSyn, 1), "E").Resize(, 7).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
End Sub