Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, d As Object, i&, s
t = [A1].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
If IsDate(t(i, 3)) Then
If d.exists(t(i, 1)) Then
s = Split(d(t(i, 1)), " Au ")
d(t(i, 1)) = IIf(t(i, 3) < CDate(s(0)), t(i, 3), s(0)) & " Au " & IIf(t(i, 3) > CDate(s(1)), t(i, 3), s(1))
Else
d(t(i, 1)) = t(i, 3) & " Au " & t(i, 3)
End If
End If
Next
For i = 2 To UBound(t)
If IsDate(t(i, 3)) Then t(i, 4) = d(t(i, 1)) Else t(i, 4) = ""
Next
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False
[D1].Resize(i - 1) = Application.Index(t, , 4)
Application.EnableEvents = True
End Sub