Macro-fonction calcul jours ouvrés

C@thy

XLDnaute Barbatruc
Bonjour les amis,

Je sépare ce fil https://www.excel-downloads.com/threads/vba-ajouter-n-jours-ouvres-a-la-date-du-jour.170492/ en deux car sinon on mélange un peu les problèmes, donc ce sera plus clair :

voici ce que j'essaie de faire :

différence entre lundi 30/04/2012 et mercredi 02/05/2012 doit me donner 1 jour d'écart car le 1er mai est férié, j'ai donc répondu à la demande dans le délai d'1 jour et non pas 2
(je précise bien car si je fais le calcul entre 2 dates normales distantes d'un jour (par ex.le mardi et le mercredi non fériés de la même semaine) je dois obtenir 1 jour mais avec
=NB.JOURS.OUVRES(A1;B1;feries) j'obtiens le résultat 2
alors qu'avec B1-A1 j'obtiens le bon résultat à savoir 1)

euh... vous me suivez toujours...???

donc mon problème est le suivant : je veux calculer l'écart entre 2 dates :
A1 = lundi 30/04/2012 B1 = mercredi 02/05/2012 en C1 : = B1-A1 j'obtiens 1
A1 = mercredi 02/05/2012 B1 = lundi 30/04/2012 D2 en C1 : = B1-A1 j'obtiens -1

ça c'est une première énigme sur laquelle je me suis penchée...
(mais contrairement à la chanson d'Adamo, je n'ai pas entendu un requiem quand sur elle je me suis penchée...)

deuxième énigme (je penche de plus en plus... et je penche donc je suis...:D:)) :

A1 = mercredi 02/05/2012 B1 = -1

opération à effectuer en C1 : = A1 + B1 donc résultat en C1 : lundi 30/04/2012

Pire que ça :

A1 = lundi 02/01/2012 B1 = -1 résultat à obtenir en C1 : vendredi 30/12/2011:eek:

Arf! Si JNP me voit, il va encore me dire que je pose des questions 'achement dures:eek::p

mais il me dirait sans doute aussi (enfin j'espère...) que ce sont les questions dures qui font progresser...:p

Merci à vous si vous avez une solution ou une partie de solution ou un début de piste

pour ne rien vous cacher j'ai fait des tentatives, mais j'ai un peu honte...:eek:
Code:
Function NBJoursOuvres(DateDebut, DateFin)
Dim I As Long  
an = Year(Date)
  For m = LBound(Fer(an)) To UBound(Fer(an))
    lesferies = lesferies & CStr(Fer(an)(m)) & ","
  Next m
If DateDebut < DateFin Then
    For I = DateDebut To DateFin
         NBJoursOuvres = NBJoursOuvres + (Weekday(CDate(I)) <> 1 And _
                           Weekday(CDate(I)) <> 7)  And InStr(lesferies, CStr(CLng(n))) = 0* True
        Next
    Else
    For I = DateDebut To DateFin Step -1
         NBJoursOuvres = NBJoursOuvres - (Weekday(CDate(I)) <> 1 And _
                           Weekday(CDate(I)) <> 7) And InStr(lesferies, CStr(CLng(n))) = 0 * True
    Next
    End If
End Function

Function fer(an%) 'liste de tous les jours fériés
Dim pq
pq = paq(an)
fer = Array(CLng(DateSerial(an, 1, 1)), CLng(DateSerial(an, 5, 1)), CLng(DateSerial(an, 5, 8)), CLng(DateSerial(an, 7, 14)), CLng(DateSerial(an, 8, 15)), CLng(DateSerial(an, 11, 1)), CLng(DateSerial(an, 11, 11)), CLng(DateSerial(an, 12, 25)), pq + 1, pq + 39, pq + 50)
End Function
 

david84

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Bonjour C@thy,
2 suggestions :
- nous placer cela sur un fichier avec des exemples significatifs où figurent les différentes possibilités envisagées, la liste des jours fériés à prendre en compte, le résultat attendu noté manuellement, etc.
- nous préciser si tu veux un résultat par macro ou VBA.
A+
 

C@thy

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Tu as tout à fait raison, David, je joins un fichier plus explicite.

Edit : en rouge : le résultat attendu.

P.S le but normalement est de ne pas se servir de la feuille Paramètres, mais de faire tous les calculs (y compris les fériés) par macro fonction...

Bises

C@thy
 

Pièces jointes

  • jours ouvres fonction.xls
    75.5 KB · Affichages: 211
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Bonjour le fil :),
Cathy, il faut arrêter l'alcool (ou la tisane, au choix :rolleyes:) :p !
Code:
=NB.JOURS.OUVRES(A1;B1;Fériés)
donne forcément 2 vu qu'il dénombre le nombre de jours qui ne sont pas WE ou fériés, bornes incluses :rolleyes:...
Donc si c'est les intervaux qui t'intéressent, il y en a toujours 1 de moins que de jours, soit effectivement le bon résultat : 1 ;)
Pour la suite, je regarde ton fichier d'abord :rolleyes:...
A + :cool:
 

david84

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Re
P.S le but normalement est de ne pas se servir de la feuille Paramètres, mais de faire tous les calculs (y compris les fériés) par macro fonction...
Qu'entends-tu par macro fonction ?
Fonction VBA donc pas de sub ?
VBA sub et/ou fonction ?
Tu ne veux donc que du VBA ?
A+

Edit : même analyse au 1er abord sans avoir vu le ficher Jean-Noël mais sait-on jamais:eek:...
 

C@thy

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Coucou la cigogne,

ben voui, c'est ce que je dis, NB.JOURS.OUVRES c'est bornes incluses, donc pas bon...
donc si j'ai bien compris tu suggères NB.JOURS.OUVRES(xxx)-1
arf... la tisane, c'est pas terrible pour réfléchir, je vais me mettre à l'alcool...
l'idéal aurait été une macro qui fait le tout, comme ça pas besoin de la feuille paramètres...
tu vois ce que je veux dire???
(ne pas obliger les utilisateurs a installer l'utilitaire d'analyse et éviter une liste des fériés...)

Et pour la 2ème énigme???

Bisous

C@thy
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Re :),
Pour la première énigme :
Code:
=(NB.JOURS.OUVRES(MIN(A1:B1);MAX(A1:B1);Fériés)-1)*SIGNE(B1-A1)
Pour la 2ème, en formule, ça ne parait pas évident au 1er abord :rolleyes:...
A + :cool:
Ajout : pas besoin de feuille paramètre si tu fais une liste nommée, non ? :rolleyes:
 

david84

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Re
pour la 1ère :
Code:
=NB.JOURS.OUVRES(A1;B1;Fer)-1
devrait convenir.
Le problème est que ton tableau des jours fériés est incomplet (pas de jour de l'an 2012...).
Pour la 2ème je regarde.
A+
 

C@thy

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Merci JNP j'avais compris cette soluce, qui n'est qu'un "pis-aller", (déjà pas mal tu me diras!)
l'idéal ce serait : pas de liste des fériés dans le classeur et pas d'utilitaire d'analyse...
(tu commences à ma connaître, pas vrai???;))

Pour la 2ème, t'as raison, c'est pas gagné, et pourtant c'est celle qui me serait le plus utile!!!...:rolleyes:
En réalité il me faudrait : 2/01/2015 (date supposée de départ en retraite de l'agent) -200 jours ouvrés!...

Bizz

C@thy
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Re :),
Re
pourquoi le 30/12/2011 ?
Si je suis ton raisonnement (si si j'essaie:rolleyes: !), tu devrais plutôt ramener le 31/12/2011 puisque le 02/01/2012 - 1 journée non fériée te ramène au 31/12/2011, non ?
le 31/12/2011 était un samedi, donc non ouvré :rolleyes:...
A + :cool:
PS : Donne le vendredi 14 mars 2014 dans ton exemple,
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

Re :),
A priori, ces 2 fonctions ont l'air de fonctionner :p :
Code:
Function DécalageJoursOuvrés(MaDate As Date, Décalage As Integer) As Date
If Décalage = 0 Then DécalageJoursOuvrés = MaDate: Exit Function
If Décalage < 0 Then
Décalage = -Décalage
Do While Décalage <> 0
MaDate = MaDate - 1
If Not EstJourFérié(MaDate) And Weekday(MaDate, vbMonday) < 6 Then Décalage = Décalage - 1
Loop
Else
Do While Décalage <> 0
MaDate = MaDate + 1
If Not EstJourFérié(MaDate) And Weekday(MaDate, vbMonday) < 6 Then Décalage = Décalage - 1
Loop
End If
DécalageJoursOuvrés = MaDate
End Function
et
Code:
Function EstJourFérié(MaDate As Date) As Boolean
' Détermination si jour férié
' adapté de Frédéric Sigoneau
Dim An
An = Year(MaDate)
Dim NbOr, Epacte, Ajust As Integer
Dim PLune, LPaques, Arr(1 To 11) As Long
If ActiveWorkbook.Date1904 Then Ajust = 1462
'calcul du Lundi de Pâques
NbOr = (An Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
LPaques = PLune - Weekday(PLune) + vbMonday + 7        'Lundi Pâques
'Vérification des fériés
Select Case MaDate
Case DateSerial(An, 1, 1) - Ajust, LPaques - Ajust, LPaques + 38 - Ajust, _
    LPaques + 49 - Ajust, DateSerial(An, 5, 1) - Ajust, DateSerial(An, 5, 8) - Ajust, _
    DateSerial(An, 7, 14) - Ajust, DateSerial(An, 8, 15) - Ajust, _
    DateSerial(An, 11, 1) - Ajust, DateSerial(An, 11, 11) - Ajust, _
    DateSerial(An, 12, 25) - Ajust
EstJourFérié = True
End Select
End Function
Bonne suite :cool:
 

herve62

XLDnaute Barbatruc
Supporter XLD
Re : Macro-fonction calcul jours ouvrés

Bonjour
La fonction : NB.JOURS.OUVRES(date_début;date_fin;jours_fériés) ne tient pas compte des WE , il lui faut donc ajouter une option que je ne connais pas , car il me semble qu'elle cherche aussi a éliminer les WE ?
La fonction : SERIE.JOUR.OUVRE( date_debut; Nb_jours_travail;jours_féries) elle donne la date de Fin d'un travail , en EXCLUANT les WE
Ex : si debut le 30/04/12 et dure 10jours , avec 1er Mai Le résultat est : 15/05/12 ,

Info : Pour ceux que cette fonction intéresse , elle n'est pas de base dans Excel pour la récupérer >
Outils > Macros complémentaires > cocher "Utilitaires d'analyse"

Si cela peut vous aider pour la suite !!!!
 

C@thy

XLDnaute Barbatruc
Re : Macro-fonction calcul jours ouvrés

JNP, je te remercie,

Ca fonctionnnnnnne!!!!! Merciiiiiiiiiiiiiiiiiiiiiiiiiiiiiii

Comme tu l'as fort bien compris, le but était d'éviter la macro complémentaire et la liste des fériés (qui en plus dans mon exemple était incomplète)

Bravoooooooooooooo:cool:

Bises


C@thy
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 113
Messages
2 085 426
Membres
102 888
dernier inscrit
medoit