Tblo recherche Min et Max par paquets

Sub es()
Dim mini As Long
Dim maxi As Long

Dim a() As Variant
Set f = Feuil1
  a = f.Range("A2:C" & f.[B65000].End(xlUp).Row).Value
  mini = Now

  For i = LBound(a) To UBound(a)
   mini = WorksheetFunction.min(mini, a(i, 2))
   maxi = WorksheetFunction.max(maxi, a(i, 2))
   
  Next i
  Cells(2, 5) = mini
    Cells(2, 6) = maxi
   

End Sub

Sub es()
Dim mini As Long
Dim maxi As Long

Dim a() As Variant
Dim besoins() As Variant
With Sheets("Feuil1")
    FinA = .Range("A" & .Rows.Count).End(xlUp).Row
    FinBesoins = .Range("D" & .Rows.Count).End(xlUp).Row
    a = .Range("A2:C" & FinA).Value
    .Range("E2:F" & FinBesoins).ClearContents
    besoins = .Range("D2:F" & FinBesoins).Value
   
   
    For i = LBound(besoins, 1) To UBound(besoins, 1)
    besoins(i, 2) = Now
        For j = LBound(a) To UBound(a)
            If a(j, 3) = besoins(i, 1) Then
                besoins(i, 2) = WorksheetFunction.min(besoins(i, 2), a(j, 2))
                besoins(i, 3) = WorksheetFunction.max(besoins(i, 3), a(j, 2))
            End If
        Next j
    Next i
   
    .Range("D2:F" & FinBesoins) = besoins
   
End With
End Sub

Option Explicit

Sub Test()
Dim derlig&, T, i&

    derlig = Cells(Rows.Count, "c").End(xlUp).Row
    T = Range("b2:c" & derlig)
    ReDim u(1 To UBound(T))
    For i = 1 To UBound(T): u(i) = T(i, 2) & Format(T(i, 1), "yyyy-mm-dd"): Next i
    QuickSort u, LBound(u), UBound(u)
    For i = 1 To UBound(u)
        T(i, 1) = CDate(Right(u(i), 10))
        T(i, 2) = Left(u(i), Len(u(i)) - 10)
    Next i
    Range("e:f").Clear
    Range("e2").Resize(UBound(T), 2) = T
    Range("e1:f1") = Range("b1:c1").Value
End Sub

Sub QuickSort(a, gauc, droi)
Dim ref, g, d, temp
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call QuickSort(a, g, droi)
  If gauc < d Then Call QuickSort(a, gauc, d)
End Sub