Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1330 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA] Datediff avec prise en compte des WE et/ou des jours ouvrés ?

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[VBA] Datediff avec prise en compte des WE et/ou des jours ouvrés ?

n°2344964
Odissine
Posté le 22-01-2020 à 16:57:35  profilanswer
 

Hello tout le monde,
 
Je galère pour trouver un moyen de calculer la différence en jour/heures/minutes entre deux dates mais sans tenir compte par exemple des heures fermées et des WE.
Ex.
Vendredi 17 janvier @ 16:00 > Lundi 20 janvier @ 09:00
Je devrais obtenir : 0j 3h 00m car par ex les heures ouvrées sont comprises entre 8h et 18h et fermé le WE !
Actuellement si je fais le calcul j'obtiens 2j 17h ...
 
J'ai trouvé une fonction qui me permet de récupérer le nombre de jours entre deux dates sans tenir compte des WE ... mais ca ne répond pas a mon besoin de prendre en compte uniquement les heures ouvrées ;)
 

Code :
  1. Function BusinessDateDiff(ByVal StartDate As Date, ByVal EndDate As Date, _
  2. Optional ByVal SaturdayIsHoliday As Boolean = True) As Long
  3. Dim incr As Date
  4. ' ensure we don't take time part into account
  5. StartDate = Int(StartDate)
  6. EndDate = Int(EndDate)
  7. ' incr can be +1 or -1
  8. If StartDate < EndDate Then incr = 1 Else incr = -1
  9. Do Until StartDate = EndDate
  10. ' skip to previous or next day
  11. StartDate = StartDate + incr
  12. If Weekday(StartDate) <> vbSunday And (Weekday(StartDate) <> vbSaturday _
  13. Or Not SaturdayIsHoliday) Then
  14. ' if it's a weekday add/subtract one to the result
  15. BusinessDateDiff = BusinessDateDiff + incr
  16. End If
  17. Loop
  18. ' when the loop is exited the function name
  19. ' contains the correct result
  20. End Function


 
Si vous avez une idée ou des pistes de reflexions je suis preneur !
Merci pour votre aide !

mood
Publicité
Posté le 22-01-2020 à 16:57:35  profilanswer
 

n°2345156
patrice337​40
Avec la réponse, c'est facile.
Posté le 24-01-2020 à 15:45:11  profilanswer
 

Bonjour,
 
Une proposition :

Code :
  1. Option Explicit
  2. Sub Test()
  3. '
  4. Dim hreDebOuvert As Date
  5. Dim hreFinOuvert As Date
  6. Dim datHreDeb As Date
  7. Dim datHreFin As Date
  8. Dim hreDeb As Date
  9. Dim hreFin As Date
  10. Dim datDeb As Date
  11. Dim datFin As Date
  12. Dim hreDif As Date
  13. Dim nbrJrs As Long
  14. Dim noJDeb As Integer
  15. Dim noJFin As Integer
  16. Dim nbrSem As Integer
  17. Dim result As String
  18.  
  19.   ' Heures ouvrées
  20.   hreDebOuvert = #8:00:00 AM#
  21.   hreFinOuvert = #6:00:00 PM#
  22.  
  23.   ' Période concernée
  24.   datHreDeb = #1/17/2020 4:00:00 PM#
  25.   datHreFin = #1/20/2020 9:00:00 AM#
  26.  
  27.   ' Séparer dates et heures
  28.   datDeb = Int(datHreDeb)
  29.   datFin = Int(datHreFin)
  30.   hreDeb = datHreDeb - datDeb
  31.   hreFin = datHreFin - datFin
  32.   ' Contrôle dates période
  33.   If datHreFin < datHreDeb Then
  34.     MsgBox "La fin de la période doit être supérieure ou égale au début de la période", vbCritical
  35.     Exit Sub
  36.   End If
  37.   noJDeb = (datDeb + 5) Mod 7
  38.   noJFin = (datFin + 5) Mod 7
  39.   If noJDeb > 4 Or noJFin > 4 Then
  40.     MsgBox "Le début et la fin de période doit être pendant les heures ouvrées", vbCritical
  41.     Exit Sub
  42.   End If
  43.   ' Reliquat d'heures
  44.   If hreDeb > hreFin Then
  45.     hreDif = hreFinOuvert - hreDeb
  46.     hreDeb = hreDebOuvert
  47.     datDeb = datDeb + 1
  48.   End If
  49.   hreDif = hreDif + hreFin - hreDebOuvert
  50.   ' Nombre de semaines
  51.   nbrJrs = datFin - datDeb
  52.   nbrSem = Int(nbrJrs / 7)
  53.   ' Reliquat jours
  54.   noJDeb = (datDeb + 5) Mod 7
  55.   nbrJrs = nbrJrs Mod 7
  56.   If noJDeb + nbrJrs > 4 Then nbrJrs = nbrJrs - 2  'WE
  57.   nbrJrs = nbrJrs + 5 * nbrSem
  58.   ' Résultat
  59.   result = nbrJrs & " j. " & Hour(hreDif) & " h. " & Minute(hreDif) & " min."
  60.  
  61.   MsgBox Format(datHreDeb, "ddd dd mmm yyyy" ) & vbCrLf & _
  62.          Format(datHreFin, "ddd dd mmm yyyy" ) & vbCrLf & _
  63.          result
  64.      
  65. End Sub


 
Ne faudrait-il pas aussi tenir compte des jours fériés ?


---------------
Cordialement, Patrice

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA] Datediff avec prise en compte des WE et/ou des jours ouvrés ?

 

Sujets relatifs
Excel VBA : fonction indiquant #value au démarrageVBA Word et Sendkeys
VBA Excel, TextBox qui ne fonctionne pas.VBA msgbox?
Python 3.7.3 arriver à prendre en compte openSSLpb script VBA sous Word pour export feuilles - laisse 1 page
VBA - Erreur Exécution[SQL] Double compte sur 2 tables en 1 requete [résolu]
[VB/VBA/VBS] Problème script pour exécuter des programmesCheckbox et VBA
Plus de sujets relatifs à : [VBA] Datediff avec prise en compte des WE et/ou des jours ouvrés ?


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR