Vba Jours Ouvrés

deniooo

XLDnaute Occasionnel
Bonjours,
Aprés recherche dans le forum je ne trouve pas ce dont j'ai besoin.
J'ai dans une colonne la date de début et dans une autre la date de fin.
J'aimerai calculé le nombre de jours ouvrés (nombres de jours sans les WE et fériés).

J'ai bien pensé à diviser le nombre de jours par 7, arrondir et multiplier par 2. Pour les statistiques ça passe pour tous les mois sauf le mois de Mai, normal beaucoup de fériés.

J'ai bien vu comment faire avec les formules, mais il faut que je le fasse en VB.

Il doit bien exister une fonction dans ce style, mais je ne la connais pas.

Auriez vous une idée ?!
 

tototiti2008

XLDnaute Barbatruc
Re : Vba Jours Ouvrés

Bonjour denioo,

essaye ça :

Code:
Function JoursOuvres(DateDeb As Variant, DateFin As Variant) As Long
    
    Dim Début As Date, Fin As Date
    Jours_ouvrés = 0
    On Error GoTo Err_Jours_ouvrés
    Début = CDate(DateDeb)
    Fin = CDate(DateFin)
    If Weekday(Début) = 1 Then
        Début = Début + 1
    ElseIf Weekday(Début) = 7 Then
        Début = Début + 2
    Else
        Jours_ouvrés = Jours_ouvrés + 7 - Weekday(Début)
        Début = Début + 9 - Weekday(Début)
    End If
    If Weekday(Fin) = 1 Then
        Fin = Fin + 1
    ElseIf Weekday(Fin) = 7 Then
        Fin = Fin + 2
    Else
        Jours_ouvrés = Jours_ouvrés - 7 + Weekday(Fin)
        Fin = Fin + 9 - Weekday(Fin)
    End If
    
    Jours_ouvrés = Jours_ouvrés + DateDiff("ww", Début, Fin) * 5
    Exit Function
Err_Jours_ouvrés:
    Jours_ouvrés = 0
End Function
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Vba Jours Ouvrés

Bonjour,

fériés est le nom d'un champ contenant les jours fériés

Code:
  d = #1/1/2008#
  f = Date
  z = Evaluate("NB.JOURS.OUVRES(""" & d & """,""" & f & """,fériés)")
  MsgBox z

Fonction personalisée:

Code:
Function NbJoursOuvres(début, fin)
  Dim i As Integer, d As Long, nfériés As Integer, témoin As Boolean
  Dim fériés(1 To 11)
  an = Year(début)
  If début > fin Then
    NbJoursOuvres = 0
  Else
    paques = DateSerial(an, 3, 23) + ((2 * (an Mod 4) + (4 * (an Mod 7) + _
      (6 * (((19 * (an Mod 19)) + 24) Mod 30) + 5))) Mod 7) + _
        ((19 * (an Mod 19) + 24) Mod 30) - 1
    fériés(1) = DateSerial(an, 1, 1)
    fériés(2) = DateSerial(an, 5, 1)
    fériés(3) = DateSerial(an, 5, 8)
    fériés(4) = DateSerial(an, 7, 14)
    fériés(5) = DateSerial(an, 8, 15)
    fériés(6) = DateSerial(an, 11, 1)
    fériés(7) = DateSerial(an, 11, 11)
    fériés(8) = DateSerial(an, 12, 25)
    fériés(9) = paques + 1
    fériés(10) = paques + 39
    fériés(11) = paques + 50
    NbJoursOuvres = 0
    For d = début To fin
      témoin = False
      For i = 1 To 11
       If d = fériés(i) Then témoin = True
      Next i
      If Weekday(d) <> 1 And Weekday(d) <> 7 And Not témoin Then NbJoursOuvres = NbJoursOuvres + 1
    Next d
 End If
End Function


JB
Formation Excel VBA JB
 

Pièces jointes

  • Classeur2.xls
    23 KB · Affichages: 247
  • Classeur2.xls
    23 KB · Affichages: 293
  • Classeur2.xls
    23 KB · Affichages: 308
Dernière édition:

deniooo

XLDnaute Occasionnel
Re : Vba Jours Ouvrés

Bonjour !
La fonction, je pense, est parfaite, mais lorsque je l'utilise, la variable An est à 1899..

Il faut bien que "début" soit une date de type 02/07/2008 et "fin" soit également une date de même type ?
 

deniooo

XLDnaute Occasionnel
Re : Vba Jours Ouvrés

je n'ai testé que la deuxiéme, d'ailleurs aprés tests, lorsque je lui passe en paramétre les valeurs de deux cellules dans lesquelles sont placées des date, la fonction fonctionne(biennnn) parfaitement.

Ce qui finalement est trés bien.

J'avais testé en rentrant une date en dur dans le code mais le format ne devait pas être bon.

Une idée ?!
 

deniooo

XLDnaute Occasionnel
Re : Vba Jours Ouvrés

Je viens de trouver un probléme à la deuxiéme fonction,

Si fin = début alors la fonction renvoie 2.
Or il devrait renvoyer 1 !

condition suplémentaire ?!

De même, j'ai des dates qui ne sont pas égale (fin = début) parce que leurs heures sont différentes.

Ne peut-on pas travailler uniquemenet sur le jour/mois/année lorsque l'on a jj/mm/yyyy hh:mm:ss ?
 
Dernière édition:

deniooo

XLDnaute Occasionnel
Re : Vba Jours Ouvrés

Je ne vois pas du tout comment utiliser int sur une date, lorsque je passe ma date ne paramétre du int il me renvoie 1..

J'ai dû rater quelque chose..

Peux tu m'expliquer ? ou m'envoyer vers un article qui me permettra de comprendre ?!
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Vba Jours Ouvrés

Je n'aime pas travailler en aveugle.
Post ton fichier.


Code:
Sub essai()
  d = #1/1/2008#
  f = Now
  z = Evaluate("NB.JOURS.OUVRES(""" & Int(d) & """,""" & Int(f) & """,fériés)")
  MsgBox z
End Sub

Code:
Sub essai2()
  d1 = #1/1/2008#
  D2 = Now      ' date et heure
  MsgBox NbJoursOuvres(Int(d1), Int(D2))
End Sub
Function NbJoursOuvres(début, fin)
  Dim i As Integer, d As Long, nfériés As Integer, témoin As Boolean
  Dim fériés(1 To 11)
  an = Year(début)
  If début > fin Then
    NbJoursOuvres = 0
  Else
    paques = DateSerial(an, 3, 23) + ((2 * (an Mod 4) + (4 * (an Mod 7) + _
      (6 * (((19 * (an Mod 19)) + 24) Mod 30) + 5))) Mod 7) + _
        ((19 * (an Mod 19) + 24) Mod 30) - 1
    fériés(1) = DateSerial(an, 1, 1)
    fériés(2) = DateSerial(an, 5, 1)
    fériés(3) = DateSerial(an, 5, 8)
    fériés(4) = DateSerial(an, 7, 14)
    fériés(5) = DateSerial(an, 8, 15)
    fériés(6) = DateSerial(an, 11, 1)
    fériés(7) = DateSerial(an, 11, 11)
    fériés(8) = DateSerial(an, 12, 25)
    fériés(9) = paques + 1
    fériés(10) = paques + 39
    fériés(11) = paques + 50
    NbJoursOuvres = 0
    For d = début To fin
      témoin = False
      For i = 1 To 11
       If d = fériés(i) Then témoin = True
      Next i
      If Weekday(d) <> 1 And Weekday(d) <> 7 And Not témoin Then NbJoursOuvres = NbJoursOuvres + 1
    Next d
 End If
End Function

JB
 

Pièces jointes

  • FonctionNbJoursOuvres.xls
    34.5 KB · Affichages: 208
  • FonctionNbJoursOuvres.xls
    34.5 KB · Affichages: 240
  • FonctionNbJoursOuvres.xls
    34.5 KB · Affichages: 251

Statistiques des forums

Discussions
312 884
Messages
2 093 242
Membres
105 658
dernier inscrit
Mario Richard