Temps de travail entre 2 dates avec contraintes

[ogavazzi]

Bonjour a tous et merci par avance de votre aide
Je galère toujours autant dès qu'il s'agit de calcul avec des dates et des heures

Mon souci du jour est de connaître la durée écoulée en heures/minutes/secondes (hh:mm:ss) entre 2 dates en fonction de contraintes :
- amplitude horaire en semaine
- amplitude horaire du vendredi
- fermeture le week end
- fermeture les jours fériés

J'en fais donc appel à votre savoir faire pour m'en sortir

En pièce jointe le fichier test

Merci d'avance

 

[job75]

Re : Temps de travail entre 2 dates avec contraintes

Re,

Comme promis, voici le fichier(3) avec la pause de 12:00 à 14:00.

J'en ai profité pour supprimer les TimeValue, inutiles puisque les heures sont déclarées As Date.

A+

 

[Victor21]

Re : Temps de travail entre 2 dates avec contraintes

Re, hoerwind, job75.

@hoerwind

1°- En pièce jointe un petit fichier que j'ai "commis" en son temps, avec pause "déjeuner".
2° -Si tu ne t'en sors pas, toujours prêt à te donner un coup de main sur ton fichier.

Merci pour le #1🙂
Quant au #2, j'ai plusieurs fois déjà eu l'occasion d'apprécier ton aide 🙂🙂

@ job75 : je vais m'empresser d'ajouter cette fonction dans mes archives, et de la décortiquer ligne par ligne, pour pouvoir m'en inspirer. Mille fois merci.🙂

 

[ogavazzi]

Re : Temps de travail entre 2 dates avec contraintes

Pour l'instant une solution qui doit être plus rapide, avec un tableau et la fonction Match (EQUIV) :

Option Explicit
Dim fer, t1 As Date, t2 As Date, t3 As Date

Function DUR#(dat1&, h1 As Date, dat2&, h2 As Date)
Dim dat&, w As Byte
fer = [Feries].Value2 'tableau
t1 = TimeValue("06:30")
t2 = TimeValue("18:30")
t3 = TimeValue("21:00")
'---premier jour (ajouté)---
DUR = PremDer(dat1, h1)
'---autres jours---
For dat = dat1 + 1 To dat2
  w = Weekday(dat, 2)
  If IsError(Application.Match(dat, fer, 0)) And w < 6 Then _
    DUR = DUR + IIf(w = 5, t2, t3) - t1
Next
'---dernier jour (déduit)---
DUR = DUR - PremDer(dat2, h2)
End Function

Function PremDer#(dat&, h As Date)
Dim w As Byte, t As Date
w = Weekday(dat, 2)
If IsError(Application.Match(dat, fer, 0)) And w < 6 Then
  t = IIf(w = 5, t2, t3)
  If h < t1 Then PremDer = t - t1 _
    Else PremDer = Application.Max(t - h, 0)
End If
End Function

A+

Comment dire....
parfait !!!
par contre je comprends pas tout... novice en VBA