Calcul de date de fin à partir d'une date de début, d'une durée et contraintes horair

=SI(OU($U2="";AC$1<$[COLOR="Red"]Z[/COLOR]2;AC$1>$[COLOR="Red"]AA[/COLOR]2);"";ChargeSem($X2;$N2;1+AC$1-$Z2))

Option Explicit

[COLOR="Red"]Function ChoixPas(t1 As Date, t2 As Date, t3 As Date, t4 As Date, t5 As Date, t6 As Date) As Byte
Dim i As Byte, d
d = Array(1, 2, 3, 4, 6, 12, 30)
ChoixPas = 1
For i = 0 To 6
  If Minute(t1 * d(i)) + Minute(t2 * d(i)) + Minute(t3 * d(i)) + Minute(t4 * d(i)) + Minute(t5 * d(i)) + Minute(t6 * d(i)) = 0 Then _
    ChoixPas = 60 / d(i): Exit Function
Next
End Function[/COLOR]

Function Datefin(deb As Date, duree As Date) As Date
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, pas As Byte, dur As Long, minutes As Long, n As Long, t As Date, dat As Long, test As Boolean
Application.Volatile 'permet le recalcul de la fonction
With Sheets("Variables")
  t1 = .[E1]
  t2 = .[E2]
  t3 = .[E3]
  t4 = .[E4]
End With
[COLOR="Red"]pas = ChoixPas(t1, t2, t3, t4, deb, duree)[/COLOR]
dur = Round(duree * 1440) 'conversion en minutes
Datefin = deb 'au cas où duree = 0
While minutes < dur
  n = n + pas
  Datefin = deb + n / 1440
  t = TimeValue(Datefin)
  If Int(CDec(Datefin)) > dat Then
    dat = Int(CDec(Datefin))
    test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
  End If
  If test And (t > t1 And t <= t2 Or t > t3 And t <= t4) Then minutes = minutes + pas
Wend
End Function

Function DateDeb(fin As Date, duree As Date) As Date
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, pas As Byte, dur As Long, dat As Long, test As Boolean, minutes As Long, n As Long, t As Date
Application.Volatile 'permet le recalcul de la fonction
With Sheets("Variables")
  t1 = .[E1]
  t2 = .[E2]
  t3 = .[E3]
  t4 = .[E4]
End With
[COLOR="Red"]pas = ChoixPas(t1, t2, t3, t4, fin, duree)[/COLOR]
dur = Round(duree * 1440) 'conversion en minutes
dat = Int(CDec(fin)) 'initialisation indispensable ici
test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
DateDeb = fin 'au cas où duree = 0
While minutes < dur
  n = n + pas
  DateDeb = fin - n / 1440
  t = TimeValue(DateDeb)
  If Int(CDec(DateDeb)) < dat Then
    dat = Int(CDec(DateDeb))
    test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
  End If
  If test And (t >= t1 And t < t2 Or t >= t3 And t < t4) Then minutes = minutes + pas
Wend
End Function

Function ChargeSem(deb As Date, duree As Date, semaine As Integer) As Variant
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, pas As Byte, sem As Integer, dur As Long
Dim Datefin As Date, minutes As Long, n As Long, t As Date, dat As Long, test As Boolean
Application.Volatile 'permet le recalcul de la fonction
With Sheets("Variables")
  t1 = .[E1]
  t2 = .[E2]
  t3 = .[E3]
  t4 = .[E4]
End With
[COLOR="Red"]pas = ChoixPas(t1, t2, t3, t4, deb, duree)[/COLOR]
If Weekday(deb, 2) > 1 Then sem = 1
dur = Round(duree * 1440) 'conversion en minutes
Do While minutes < dur
  n = n + pas
  Datefin = deb + n / 1440
  t = TimeValue(Datefin)
  If Int(CDec(Datefin)) > dat Then
    dat = Int(CDec(Datefin))
    test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
    If Weekday(dat, 2) = 1 Then sem = sem + 1: If sem > semaine Then Exit Do
  End If
  If test And (t > t1 And t <= t2 Or t > t3 And t <= t4) Then
    minutes = minutes + pas
    If sem = semaine Then ChargeSem = ChargeSem + pas
  End If
Loop
If ChargeSem Then ChargeSem = ChargeSem / 1440 Else ChargeSem = "" 'pour ne rien afficher si charge nulle
End Function

Function ChoixPas(t1 As Date, t2 As Date, t3 As Date, t4 As Date, t5 As Date, t6 As Date) As Byte
Dim i As Byte, d
d = Array(1, 2, 3, 4, [COLOR="Red"]5,[/COLOR] 6, [COLOR="Red"]10,[/COLOR] 12, [COLOR="Red"]15, 20,[/COLOR] 30)
ChoixPas = 1
For i = 0 To [COLOR="Red"]10[/COLOR]
  If Minute(t1 * d(i)) + Minute(t2 * d(i)) + Minute(t3 * d(i)) + Minute(t4 * d(i)) + Minute(t5 * d(i)) + Minute(t6 * d(i)) = 0 Then _
    ChoixPas = 60 / d(i): Exit Function
Next
End Function

Option Explicit

Function Datefin(deb As Date, duree As Date) As Date
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, jour As Date, dat&, t As Date, dur As Date, d!
Application.Volatile 'permet le recalcul de la fonction
With Sheets("Variables")
  t1 = .[E1]
  t2 = .[E2]
  t3 = .[E3]
  t4 = .[E4]
End With
jour = t2 - t1 + t4 - t3
dat = Int(CDec(deb))
t = TimeValue(deb)
If IsError(Application.Match(dat, [Feries], 0)) And WeekDay(dat, 2) < 6 Then
  If t <= t1 Then dur = jour
  If t > t1 And t < t2 Then dur = t2 - t + t4 - t3
  If t >= t2 And t < t3 Then dur = t4 - t3
  If t >= t3 And t < t4 Then dur = t4 - t
End If
While dur < duree
  dat = dat + 1
  If IsError(Application.Match(dat, [Feries], 0)) And WeekDay(dat, 2) < 6 Then dur = dur + jour
Wend
d = dur - duree
Datefin = dat + t4 - d - IIf(d > t4 - t3, t3 - t2, 0)
End Function

Function DateDeb(fin As Date, duree As Date) As Date
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, jour As Date, dat&, t As Date, dur As Date, d!
Application.Volatile 'permet le recalcul de la fonction
With Sheets("Variables")
  t1 = .[E1]
  t2 = .[E2]
  t3 = .[E3]
  t4 = .[E4]
End With
jour = t2 - t1 + t4 - t3
dat = Int(CDec(fin))
t = TimeValue(fin)
If IsError(Application.Match(dat, [Feries], 0)) And WeekDay(dat, 2) < 6 Then
  If t > t1 And t < t2 Then dur = t - t1
  If t >= t2 And t < t3 Then dur = t2 - t1
  If t >= t3 And t < t4 Then dur = t2 - t1 + t - t3
  If t >= t4 Then dur = jour
End If
While dur < duree
  dat = dat - 1
  If IsError(Application.Match(dat, [Feries], 0)) And WeekDay(dat, 2) < 6 Then dur = dur + jour
Wend
d = dur - duree
DateDeb = dat + t1 + d + IIf(d > t2 - t1, t3 - t2, 0)
End Function

Function ChargeSem(deb As Date, duree As Date, semaine&) As Variant
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, jour As Date, dat&, t As Date, sem&, dur As Date
Application.Volatile 'permet le recalcul de la fonction
With Sheets("Variables")
  t1 = .[E1]
  t2 = .[E2]
  t3 = .[E3]
  t4 = .[E4]
End With
jour = t2 - t1 + t4 - t3
dat = Int(CDec(deb))
t = TimeValue(deb)
sem = 1
If IsError(Application.Match(dat, [Feries], 0)) And WeekDay(dat, 2) < 6 Then
  If t <= t1 Then dur = jour
  If t > t1 And t < t2 Then dur = t2 - t + t4 - t3
  If t >= t2 And t < t3 Then dur = t4 - t3
  If t >= t3 And t < t4 Then dur = t4 - t
End If
If semaine = 1 Then ChargeSem = dur
While dur < duree
  dat = dat + 1
  If WeekDay(dat, 2) = 1 Then sem = sem + 1: If sem > semaine Then Exit Function
  If IsError(Application.Match(dat, [Feries], 0)) And WeekDay(dat, 2) < 6 Then
    dur = dur + jour
    If sem = semaine Then ChargeSem = ChargeSem + jour
  End If
Wend
If sem = semaine Then ChargeSem = ChargeSem - dur + duree Else: ChargeSem = ""
End Function

If IsError(Application.Match(dat, [Feries], 0)) And ([COLOR="Red"]test Or[/COLOR] WeekDay(dat, 2) < 6) Then

Datefin = dat + t4 - d - IIf(d [COLOR="Red"][B]>=[/B][/COLOR] t4 - t3, t3 - t2, 0)