Besoin d'un Génie sur Excel :-)

[COLOR="DarkSlateGray"][B]
Code supprimé[/B][/COLOR]

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, k&, tmp#
Dim CelRef
Dim oPlg0 As Range, oPlg1 As Range, sDat#(), oColl As New Collection
  CelRef = Array("D17", "F17")
  Set oPlg0 = Range(Range(CelRef(0)), Cells(Rows.Count, Range(CelRef(0)).Column).End(xlUp))
  If oPlg0.Count > 1 Then
    Set oPlg1 = oPlg0.Offset(Range(CelRef(1)).Row - Range(CelRef(0)).Row, Range(CelRef(1)).Column - Range(CelRef(0)).Column)
    ReDim sDat(1 To oPlg0.Count - 1, 1 To 1)
    On Error Resume Next
    For i = 2 To oPlg0.Count
      sDat(i - 1, 1) = Round(CDbl(oPlg0.Cells(i, 1)) + CDbl(oPlg1.Cells(i, 1)), 6)
      oColl.Add sDat(i - 1, 1), CStr(sDat(i - 1, 1))
    Next i
    On Error GoTo 0

    Do While oColl.Count < UBound(sDat, 1)
      For i = 1 To oColl.Count
        tmp = oColl(i)
        k = 0
        On Error Resume Next
        For j = 1 To UBound(sDat, 1)
          If tmp = sDat(j, 1) Then
            sDat(j, 1) = Round(sDat(j, 1) + k / 1440, 6)
            If k Then oColl.Add sDat(j, 1), CStr(sDat(j, 1))
            k = k + 1
          End If
        Next j
        On Error GoTo 0
      Next i
    Loop

    With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
    For i = 1 To UBound(sDat, 1)
      Range(CelRef(0)).Offset(i, 0).Value = Int(sDat(i, 1))
      Range(CelRef(1)).Offset(i, 0).Value = sDat(i, 1) - Int(sDat(i, 1))
    Next i
    With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With

  End If
End Sub[/B][/COLOR]