Macro-fonction calcul jours ouvrés

C@thy · 13 Janvier 2012

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...) :

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

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

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

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...

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

C@thy · 13 Janvier 2012

Re : Macro-fonction calcul jours ouvrés

JNP, c'est pas toi qui disait :

JNP à dit:
Pour la 2ème, en formule, ça ne parait pas évident au 1er abord ...

??

Donc, si je reprends mon 1er problème (qui paraissait plus simple au 1er rabord), on pourrait pas arriver à faire une fonction du même acabit???

P.S. elle est pas belle, la langue française? Pourquoi acabit et gabarit prennent un t à la fin??? (ouf! heureusement qu'on ne le prononce pas...)

Au plaisir de lire tes belles trouvailles!

Bisous bisous

C@thy

JNP · 13 Janvier 2012

Re : Macro-fonction calcul jours ouvrés

Re ,
Un peu l'impression de réinventer la poudre ...

Code:

Function CompteJoursOuvrés(DateDébut As Date, DateFin As Date) As Integer
Dim I As Date
For I = DateDébut To DateFin Step IIf(DateFin > DateDébut, 1, -1)
If Not EstJourFérié(I) And Weekday(I, vbMonday) < 6 Then CompteJoursOuvrés = CompteJoursOuvrés + 1
Next I
If CompteJoursOuvrés = 0 Then Exit Function
CompteJoursOuvrés = (CompteJoursOuvrés - 1) * IIf(DateFin > DateDébut, 1, -1)
End Function

Sinon, avec la fonction de FS

Code:

Function JoursFériés(An)
' Détermination perpétuelle des jours fériés par année - Résultats sous forme de tableau
' Frédéric Sigoneau
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
  
  'tableau des fériés
  Arr(1) = DateSerial(An, 1, 1) - Ajust
  Arr(2) = LPaques - Ajust
  Arr(3) = LPaques + 38 - Ajust  'Ascension
  Arr(4) = LPaques + 49 - Ajust  'Pentecôte
  Arr(5) = DateSerial(An, 5, 1) - Ajust
  Arr(6) = DateSerial(An, 5, 8) - Ajust
  Arr(7) = DateSerial(An, 7, 14) - Ajust
  Arr(8) = DateSerial(An, 8, 15) - Ajust
  Arr(9) = DateSerial(An, 11, 1) - Ajust
  Arr(10) = DateSerial(An, 11, 11) - Ajust
  Arr(11) = DateSerial(An, 12, 25) - Ajust
  
  'tri du tableau
  Dim I%, J%, K%, tmp
  For I = LBound(Arr) To UBound(Arr)
    J = I
    For K = J + 1 To UBound(Arr)
      If Arr(K) <= Arr(J) Then J = K
    Next K
    If I <> J Then
      tmp = Arr(J): Arr(J) = Arr(I): Arr(I) = tmp
    End If
  Next I
  
  'renvoi du résultat
  On Error GoTo Fin
  If Application.Caller.Rows.Count > 1 Then
    JoursFériés = Application.Transpose(Arr)
    Exit Function
  End If
Fin:
  JoursFériés = Arr
End Function 'fs

Il te suffit de sélectionner 11 cellules et de valider en matricielle

Code:

=JoursFériés(2012)

et ainsi de suite par année pour avoir une liste de fériés valides, et pouvoir passer par de "bêtes" formules de feuille pour le reste ...
Bises

C@thy · 13 Janvier 2012

Re : Macro-fonction calcul jours ouvrés

Merci pour ta poudre elle me va bien au teint.

Ça m'a l'air tout SUPER tout ça vais tester

Bisous

C@thy

C@thy · 16 Janvier 2012

Re : Macro-fonction calcul jours ouvrés

Coucou JNP,

Ca y est j'ai testé, le comptage se fait nickel tout comme il faut
en positif comme en négatif

Bravo!!! et un grand MERCI à toi

bibises et bonne journée

C@thy

Macro-fonction calcul jours ouvrés

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

Discussions similaires