Sub recap2()
Feuil1.Columns("D:E").ClearContents
Set monDico = CreateObject("Scripting.Dictionary")
tablo = Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(n, 1) <> "" Then
x = CDbl(CDate(tablo(n, 1)))
If tablo(n, 2) <> "" Then
monDico(x) = monDico(x) + 1
Else
monDico(x) = 0
End If
End If
Next
a = monDico.keys
b = monDico.items
Range("D1").Resize(UBound(a) + 1) = Application.Transpose(a)
Range("E1").Resize(UBound(b) + 1) = Application.Transpose(b)
End Sub