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

[Fiou]

Bonjour à tous,

Je viens solliciter les âmes charitables en espérant trouver une réponse ici.

Voilà, je cherche tout simplement à calculer une date de fin à partir d'une date de début, d'une durée et de contraintes horaires de travail.

J'ai déjà réussi à réaliser un planning au jour avec gestion des jours fériés mais pas encore à l'heure/minutes prêt.

Exemple :

Horaire de travail Lundi au Vendredi : 8h-12h 13h-17h

Date de début : 21/06/2010 9:00:00 Durée : 30h

Quelle est la formule afin de déterminer la date de fin ?!

Je ne sais pas si c'est réalisable sous Excel mais MERCI d'avance pour votre aide.

Je dispose d'Excel 2007 et éventuellement de Crystal Reports 2008.

 

[Fiou]

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

Salut Job et Bonnes vacances !!

Petit rappel : C'est fait pour se reposer les vacances...

En tout cas merci ! je passe d'environ 30 min à 10 min avec ce changement

Je vais regarder si j'en ai d'autres du genre...

MERCI

 

[job75]

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

Re,

Je suppose que vous avez corrigé vous-même, la bonne formule en AC2 est :

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

A+

 

[Fiou]

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

Re

Oui j'ai effectivement corrigé dans ce sens.

Merci

 

[job75]

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

Bonjour Fiou, le forum,

Voici une méthode assez radicale qui doit - normalement - permettre de réduire considérablement la durée du calcul.

Elle consiste à remplacer le pas de 1 minute par un pas bien plus grand adapté aux données de base (minutes).

Il suffit pour cela que les minutes aient des diviseurs communs avec 60.

Utilisez donc le code suivant avec la fonction ChoixPas (en rouge) :

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

Merci de nous dire quelle est la nouvelle durée du calcul sur votre fichier.

A+

 

[Fiou]

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

Salut le vacancier !

Mon fichier était traité entre 10-15 min, je viens de le traiter en 4 min exactement à l'instant.

C'est que du bonheur !

Cela va apporter beaucoup de souplesse en cas de changements de données sources..

MERCI

 

[job75]

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

Bonjour Fiou, le forum,

Dans ChoixPas, je n'avais pas mis tous les diviseurs de 60.

Ce code améliorera peut-être encore un peu la durée du calcul :

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

A+

 

[Fiou]

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

Bonjour Job !

Encore un peu de temps grappillé merci !

Petite question ?! :

Je comprends que le code calcul le nombre de minutes atteintes entre 2 dates mais
Plutôt que de compter le nombre de minutes entre 2 dates, ne serait-il pas judicieux/rapide de retrancher les jours complets entre ces 2 dates... ?!

Durée jour travaillé : 8h
Durée tache : 22h

Début Tache : Lundi 8h

Calcul : 22h/8 -> 2.75

Fin de tache = Lundi 8h + 2 jours
= Mercredi 8h + 0.75*8*60
= Mercredi 8h + 6h
= Mercredi 14h

C'est peut être déjà le cas...



Mais c'est déjà parfait. C'était juste pour faire avancer le schmilblik...

Autre question j'utilise la formule RECHERCHEV qui ne parait pas très performante mais fonctionne... Il y a t-il plus efficace ?!

A+

 

[job75]

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

Bonjour Fiou, le forum,

Je comprends que le code calcul le nombre de minutes atteintes entre 2 dates (...)

Non, pour les deux 1ères fonctions en tout cas, la 2ème date n'est pas connue puisque la fonction sert à la calculer...

Il est par contre possible de mettre un pas de 1 jour (1440 minutes) pour les jours autres que le 1er et le dernier.

Cela complique nettement les fonctions, et j'ai préféré en rester là

Edit : quant au principe du calcul que vous indiquez, ce serait OK si toutes les heures étaient travaillées, sans week-ends ni jours fériés...

A+

 

[job75]

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

Bonsoir Fiou, le forum,

Finalement l'incrémentation même améliorée ne me plaisait pas, et 4 minutes pour 5000 lignes c'est encore trop.

Alors je pense avoir trouvé LA solution avec le code suivant (pas de 1 jour) :

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

Voir aussi le fichier joint pour tester facilement les 3 fonctions.

A+

 

[Fiou]

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

Salut Job !

Tout simplement hallucinant

Je suis à moins d'1 minute pour traiter mon fichier.

C'est que du bonheur...

Merci pour ton perfectionnisme et ton implication pour la résolution de ce sujet.

Encore une fois de plus un grand

MERCI

Sans vouloir abuser, mais je pense que cette demande est complémentaire et peut en intéresser d'autres (Mariet92)

Le fichier se base sur une semaine ouvrée du Lundi au Vendredi, il serait appréciable de pouvoir moduler cette semaine pour ceux qui travaillent malheureusement le samedi ou dimanche...

A+ De mon coté j'essaye de décrypter ton code...

 

[job75]

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

Bonjour Fiou, le forum,

J'ai édité mon post précédent en supprimant une variable inutile (j), prenez le nouveau code.

Si des gens travaillent le samedi ou le dimanche, il faut les repérer avec une variable (test) => True s'ils travaillent.

Et compléter où nécessaire les tests suivants dans le code :

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

A+

 

[job75]

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

Bonsoir Fiou,

Dans mon post précédent, je n'avais pas eu le temps d'être plus explicite sur les week-ends.

Je pense que vous comprendrez facilement le fichier joint, avec la variable WE (comme argument des fonctions).

A+

 

[Fiou]

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

Bonjour Job !

Bon la fonction ne me plaît pas tout à fait dans le sens ou je ne peux pas déterminer une semaine type avec des jours travaillés ou non.

J'ai essayé de modifier le code moi même

Qu'en penses tu ?!

Toujours avec en boucle d'incrémentation "MERCI"

A+

 

[job75]

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

Bonsoir Fiou, le forum,

Votre méthode fonctionne, mais c'est un peu compliqué je trouve.

Autant faire simple, voyez le fichier joint avec la variable plage.

Par ailleurs votre exemple montre bien qu'il fallait (légèrement) modifier la 1ère fonction sur cette ligne :

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

A+

 

[job75]

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

Bonjour Fiou, le forum,

Avant d'en finir Fiou, j'aimerais bien savoir si l'introduction de la variable F (un tableau) pour la plage [Feries] fait gagner du temps (et combien) sur votre gros fichier.

Voir fichier (5) joint, merci d'avance.

A+