Private Sub Worksheet_Activate()
Dim tablo, d As Object, i As Long, t As String, a, b, R(), s
With Feuil2 'CodeName de la feuille
tablo = .Range("B4:C" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
t = Replace(tablo(i, 1) & " " & tablo(i, 2), ",", ".")
d(t) = d(t) + 1 'comptage
Next
a = d.keys: b = d.items
ReDim R(d.Count - 1, 3) 'base 0, 4 colonnes
For i = 0 To d.Count - 1
s = Split(a(i))
R(i, 0) = b(i)
R(i, 1) = s(0)
R(i, 2) = s(1)
R(i, 3) = Val(s(1)) - Val(s(0)) 'Durée
Next
Application.ScreenUpdating = False 'fige l'écran
[A4].Resize(d.Count, 4) = R
[A4].Resize(d.Count, 4).Sort [B4], , [C4], Header:=xlNo 'tri sur H début et H fin
Range("A" & d.Count + 4 & ":D" & Rows.Count).ClearContents
End Sub