Vba Jours Ouvrés

D

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 ?!
 
Trier par date Trier par votes
tototiti2008

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
 
Vote positif 0 Vote négatif
BOISGONTIER

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:
Vote positif 0 Vote négatif
D

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 ?
 
Vote positif 0 Vote négatif
D

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 ?!
 
Vote positif 0 Vote négatif
D

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:
Vote positif 0 Vote négatif
D

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:
Vote positif 0 Vote négatif
BOISGONTIER

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
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2016 Nombre de jours effectués par mois
Réponses
12
Affichages
828
CathU
C
I
  • Résolu(e)
XL 2016 Formules Excel
Réponses
3
Affichages
190
DJunqueira
D
lemanois
  • Question
Microsoft 365 Date échéance avec jours ouvrés
Réponses
5
Affichages
171
lemanois
lemanois
W
  • Question
Microsoft 365 Formule avec conditions jours ouvrés
Réponses
5
Affichages
384
sylvanu
sylvanu
R
  • Résolu(e)
XL 2013 Décalages des jours fériés
Réponses
5
Affichages
195
Rom150
R
G
  • Question
XL 2016 additionner les cellules avant la cellule de ref selon condition
Réponses
13
Affichages
224
DJunqueira
D
@
  • Question
Microsoft 365 Graphique avec jours ouvrés
2
Réponses
15
Affichages
738
@Johan
@
D
  • Résolu(e)
Microsoft 365 Calculer jours ouvrés entre 2 dates
Réponses
9
Affichages
554
DR85
D
M
  • Question
Microsoft 365 Jours ouvrés
Réponses
5
Affichages
510
Cousinhub
Cousinhub
G
  • Question
XL 2019 Calcul nombre jours ouvrables (non ouvrés)
Réponses
5
Affichages
443
Graounette92
G

Membres actuellement en ligne

2 membres et 32 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 348
Messages
2 087 510
Membres
103 570
dernier inscrit
patrickb83p