Option Explicit
Sub Test()
Reperer Sheets("Feuil1").Range("A2:A500"), 90, 5
End Sub
Sub Reperer(Plage As Range, DureeMax As Long, NBmini As Long)
Dim tablo, First As Range, i1 As Long, i As Long, diff As Long, k As Long, coul As Boolean
With Plage.Parent
Plage.Offset(, 1).ClearContents
Plage.Resize(, 2).Interior.Color = xlNone
i1 = 1: i = i1 + 1
Do ''While i <= Plage.Count
DoEvents
If (Plage(i, 1) - Plage(i1, 1)) <= 90 And (Plage(i + 1, 1) - Plage(i1, 1)) > 90 And (i - i1 + 1) >= NBmini Then
For k = i1 To i
Plage(k, 2) = Plage(k, 1)
Next k
coul = Not coul
.Range(Plage(i1, 1), Plage(i, 2)).Interior.Color = IIf(coul, RGB(196, 255, 0), RGB(134, 203, 255))
i1 = i + 1: i = i1 + 1
ElseIf (Plage(i, 1) - Plage(i1, 1)) <= 90 And (Plage(i + 1, 1) - Plage(i1, 1)) > 90 And (i - i1 + 1) < NBmini Then
i1 = i1 + 1: i = i1 + 1
ElseIf (Plage(i, 1) - Plage(i1, 1)) > 90 Then
i1 = i1 + 1: i = i1 + 1
Else
i = i + 1
End If
Loop Until i > Plage.Count
i = i - 1
If (Plage(i, 1) - Plage(i1, 1)) <= 90 And (i - i1 + 1) >= NBmini Then
For k = i1 To i
Plage(k, 2) = Plage(k, 1)
Next k
coul = Not coul
.Range(Plage(i1, 1), Plage(i, 2)).Interior.Color = IIf(coul, RGB(196, 255, 0), RGB(134, 203, 255))
End If
End With
End Sub