Sub AnnéeService()
Dim DerL As Long, MonTab, Deb As Integer, Fin As Integer
Dim Durée As Integer
Start = Timer
With Worksheets("Feuil1")
DerL = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:B" & DerL).Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
MonTab = .Range("A2:C" & DerL)
Prec = ""
For i = LBound(MonTab) To UBound(MonTab)
If MonTab(i, 2) = Prec Then
MonTab(i, 3) = Durée
Else
Deb = MonTab(i, 1)
Fin = MonTab(i, 1)
For j = i + 1 To UBound(MonTab)
If MonTab(j, 2) = MonTab(i, 2) Then
If MonTab(j, 1) > Fin Then Fin = MonTab(j, 1)
End If
Next
Durée = Fin - Deb + 1
MonTab(i, 3) = Durée
Prec = MonTab(i, 2)
End If
Next
.Range("A2").Resize(UBound(MonTab, 1), UBound(MonTab, 2)) = MonTab
.Range("A2:C" & DerL).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1
.Range("D2") = Timer - Start
End With
End Sub