Option Explicit
Option Base 1
Sub Analyse()
Dim i As Long
Dim ShDonn As Worksheet
Dim d As Object
Dim c As Variant
Set d = CreateObject("Scripting.Dictionary")
Set ShDonn = Sheets("Données")
With ShDonn
For i = 2 To 5000
If .Cells(i, 1).Value = "" Then Exit For
If .Cells(i + 1, 4).Value > .Cells(i, 4).Value Then
d(.Cells(i, 2).Value & "|" & .Cells(i + 1, 2).Value) = d(.Cells(i, 2).Value & "|" & .Cells(i + 1, 2).Value) + 1
End If
If .Cells(i, 4).Value = 1 Then d(.Cells(i, 2).Value) = 1 + d(.Cells(i, 2).Value)
Next i
End With
End Sub