Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C6]) Is Nothing Then Exit Sub
Dim dat, tablo, resu(), d As Object, i&, firme$, n&
dat = [C6]
If Not IsDate(dat) And dat <> "" Then [C6] = ""
tablo = Sheets("Tableau").ListObjects(1).Range.Resize(, 8) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 3)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
If IsDate(tablo(i, 3)) And tablo(i, 3) <= dat Then
firme = tablo(i, 5)
If Not d.exists(firme) Then n = n + 1: d(firme) = n: resu(n, 1) = firme
If IsNumeric(tablo(i, 7)) Then resu(n, 2) = resu(n, 2) + CDbl(tablo(i, 7))
If IsNumeric(tablo(i, 8)) Then resu(n, 3) = resu(n, 3) + CDbl(tablo(i, 8))
End If
Next
'---restitution---
With ListObjects(1).Range.Rows(2)
If n Then
.Cells(1).Resize(n, 3) = resu
.Cells(1).Resize(n, 3).Sort .Cells(1), xlAscending, Header:=xlYes 'tri sur les firmes
.Cells(1, 4).Resize(n) = "=RC[-1]-RC[-2]"
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1).EntireRow.Delete 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub