Prendre uniquement la dernière ligne d'une journée

Option Explicit
'--------
Sub derniere_heure()
Dim Derlig As Long, T_in(), Idx As Long, jour as Double
Dim D_max As Object
Dim start As Single

start = Timer
Application.ScreenUpdating = False
With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_in = Application.Transpose(.Range("A2:A" & Derlig)) 'début des tops en A2
End With
Set D_max = CreateObject("scripting.dictionary")

For Idx = 1 To UBound(T_in)
     jour = Int(T_in(Idx))
     If Not D_max.exists(jour) Then
          D_max.Add jour, T_in(Idx)
     Else
          If T_in(Idx) > D_max.Item(jour) Then D_max.Item(jour) = T_in(Idx)
     End If
Next

With Sheets(2)
     .Columns("A").Clear
     With .Range("A2").Resize(D_max.Count, 1)
          .Value = Application.Transpose(D_max.items)
          .NumberFormat = "dd/mm/yy h:mm;@"
          .Borders.Weight = xlThin
     End With
     .Activate
End With

Application.ScreenUpdating = True
MsgBox "Derniers tops journaliers extraits en " & Timer - start & " sec."
End Sub