Sub toto()
Dim i&, j&, n&, d#, f#, hd&, hf&, jd&, jf&
Dim s(287, 6), v()
With Feuil1.[E2]
n = .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row
v = .Resize(n, 2).Value
End With
For i = 1 To n - 1
d = Round(v(i, 1), 5)
f = Round(v(i, 2) - 5.85480093676815E-06, 5)
If 0 < f - d And f - d < 1 Then
hd = Int(288 * (d - Int(d))): jd = (Int(d) - 2) Mod 7
hf = Int(288 * (f - Int(f))): jf = (Int(f) - 2) Mod 7
If jd = jf Then
For j = hd To hf: s(j, jd) = 1 + s(j, jd): Next
Else
For j = hd To 287: s(j, jd) = 1 + s(j, jd): Next
For j = 0 To hf: s(j, jf) = 1 + s(j, jf): Next
End If
End If
Next
Feuil1.[I3].Resize(288, 7).Value = s
End Sub