Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C3]) Is Nothing Then
Application.ScreenUpdating = False
With Sheets("Feuil1")
tablo = .Range("A2:F" & .Range("A1000000").End(xlUp).Row) ' Transfert dans tablo
End With
Range("B6:G7").ClearContents
Hmin = "23:59": Hmax = 0: IndMin = 0: IndMax = 0: DateCherchée = [C3]
For i = 1 To UBound(tablo)
If tablo(i, 2) = DateCherchée Then ' Si bonne date
If tablo(i, 5) < Hmin Then ' Si heure< min mémorisé
Hmin = tablo(i, 5): IndMin = i ' On mémorise
End If
If tablo(i, 5) > Hmax Then ' Si heure> max mémorisé
Hmax = tablo(i, 5): IndMax = i ' On mémorise
End If
End If
Next i
For C = 1 To 6 ' On restitue les deux RV
Cells(6, C + 1) = tablo(IndMin, C)
Cells(7, C + 1) = tablo(IndMax, C)
Next C
End If
Fin:
Application.ScreenUpdating = True
End Sub