Calcul de nombre de jours ouvrés VBA EXCEL [Résolu/Fermé]

Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
-
Bonjour,

Je souhaite insérer une macro VBA qui calcul le nombre de jours ouvrés entre la valeur de la cellule E2 et celle de la G2 et donne le résultat en K2
Le top serait que ce soit actif pour l'intégralité des cellules des colonnes concernées.

Le calcul est à effectuer lorsque le contenu de la colonne I est diffèrent de vide (liste : oui.non déjà établie)

Voila, j'intègrerais ensuite ce calcul dans une autre Macro.
Merci d'avance pour vos propositions !
Afficher la suite 

10 réponses

Meilleure réponse
Messages postés
1771
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
29 juin 2019
351
2
Merci
Bonjour,

La fonction microsoft demande un paramétrage des jours fériés.

C'est pourquoi, j'ai développé ma propre fonction :
nb_jours_ouvrés(date_début, date_fin)


Function nb_jours_ouvrés(date_début, date_fin) As Integer
    
    ' contrôle dates ------------------------------
    If Not IsDate(date_début) Then
        MsgBox "la date début n'est pas une date "
        Exit Function
    End If
    If Not IsDate(date_fin) Then
        MsgBox "la date fin n'est pas une date "
        Exit Function
    End If
    If date_fin < date_début Then
        MsgBox "la date fin n'est pas supérieure à la date début "
        Exit Function
    End If
    
    ' nb jours calendaires ------------------------------
    nb_jours_calendaires = date_fin - date_début
   
    ' détection jours non ouvrés ------------------------------
    nb_jours_non_ouvrés = 0
    For date_i = date_début To date_fin
        If DatePart("w", date_i, vbMonday) = 6 _
        Or DatePart("w", date_i, vbMonday) = 7 _
        Or date_i = premier_jour_année(Year(date_i)) _
        Or date_i = lundi_Paques(Year(date_i)) _
        Or date_i = premier_mai(Year(date_i)) _
        Or date_i = huit_mai(Year(date_i)) _
        Or date_i = jeudi_Ascension(Year(date_i)) _
        Or date_i = lundi_Pentecote(Year(date_i)) _
        Or date_i = fête_nationale(Year(date_i)) _
        Or date_i = onze_novembre(Year(date_i)) _
        Or date_i = noël(Year(date_i)) Then
            nb_jours_non_ouvrés = nb_jours_non_ouvrés + 1
        End If
    Next
    '---------------------------------------------------------------
    
    ' nb jours ouvrés  ------------------------------
    nb_jours_ouvrés = nb_jours_calendaires - nb_jours_non_ouvrés

End Function


Function premier_jour_année(année As Integer) As String

premier_jour_année = DateSerial(année, 1, 1)

End Function



Function premier_mai(année As Integer) As String

premier_mai = DateSerial(année, 5, 1)

End Function



Function huit_mai(année As Integer) As String

huit_mai = DateSerial(année, 5, 8)

End Function


Function fête_nationale(année As Integer) As String

fête_nationale = DateSerial(année, 7, 14)

End Function


Function onze_novembre(année As Integer) As String

onze_novembre = DateSerial(année, 11, 11)

End Function
Function noël(année As Integer) As String

noël = DateSerial(année, 12, 25)

End Function


Function lundi_Paques(année As Integer) As String

lundi_Paques = DateAdd("d", 1, date_Paques(année))

End Function



Function jeudi_Ascension(année As Integer) As String

jeudi_Ascension = DateAdd("d", 39, date_Paques(année))

End Function




Function lundi_Pentecote(année As Integer) As String

lundi_Pentecote = DateAdd("d", 50, date_Paques(année))

End Function
  



Function date_Paques(année As Integer) As String

Dim a, b, c, d, e, f, g, h, i, k, l, m, r, mois, jour
    a = année Mod 19
    b = année \ 100
    c = année Mod 100
    d = b \ 4
    e = b Mod 4
    f = (b + 8) \ 25
    g = (b - f + 1) \ 3
    h = (19 * a + b - d - g + 15) Mod 30
    i = c \ 4
    k = c Mod 4
    l = (32 + 2 * e + 2 * i - h - k) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    r = (114 + h + l - 7 * m)
    mois = r \ 31
    jour = r Mod 31 + 1
   
    date_Paques = DateSerial(année, mois, jour)

End Function


Dire « Merci » 2

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60248 internautes nous ont dit merci ce mois-ci

Messages postés
22891
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
19 septembre 2019
5638
1
Merci
Bonjour,

Autant utiliser la fonction prévue pour : http://office.microsoft.com/fr-ca/excel-help/nb-jours-ouvres-HP005209190.aspx
Il te faudra peut-être activer la macro complémentaire 'Utilitaire d'analyse' pour qu'elle soit accessible.

eric
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
19
0
Merci
Merci a vous, j'étais absent mais je regarde ça de prés dès cet AM
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
19
0
Merci
Bonjour,

Je suis en cours d'analyse de la longue fonction proposée par thev, car mon fichier étant une feuille de demande de prévision de congés, j'ai besoin que les fonctions soient disponibles sur toues les lignes d'une colonnes désignée. Ce qui exclue à peu près je crois, l'utilisation de fonction de base d'Excel car il me faudrait insérer une ligne a chaque fois (hors je ne suis pas sur que les utilisateur y penseraient)

Je vais donc tenter d'intégrer la macro de thev a ma précédente macro.
Merci pour votre aide encore une fois :)
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
19
0
Merci
J'ai quand même une question :
Comment dois je paramétrer la macro pour que ma "date_debut" soient lu en colonne F et ma "date_fin" soit lue en G ? et ce pour toutes les lignes au fur et a mesure qu'elle sont remplies ?
Le résultat du nombre de jours ouvrés calculés devant apparaitre en colonne "K" sur la ligne en cours.
Messages postés
1771
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
29 juin 2019
351
0
Merci

Sub macro()

Dim ligne As Range

For Each ligne In ActiveSheet.UsedRange.Rows
    no_ligne = ligne.Row
    Columns("K").Rows(no_ligne) = nb_jours_ouvrés(Columns("F").Rows(no_ligne).Value, Columns("G").Rows(no_ligne).Value)
Next


End sub

Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
19
0
Merci
Merci thev :)
ta macro semble répondre à la fonction. je dois dire que j'ai beaucoup de mal a l'intégrer dans la macro qui doit l'englober :(
Mais je persiste ^^
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
19
0
Merci
Alors, voici ou j'en suis :
La macro est intégrée, elle est bien appelée mais plante en m'indiquant que la date de début n'est pas une date (hors j'ai vérifié le format de la cellule etc, c'est bien une date).

J'ai déclaré les différents paramètres en début de fonction, quelqu'un pourrait il m'indiquer ou es l'erreur svp ?

*** Edit ****
Serait il possible que ce soit dû au fait que la première ligne est constituée des titres ?
Si oui, comment faire en sorte que les calculs de jours ouvrés ne se fassent que sur les lignes remplies ?

Merci d'avance pour votre aide.



voici la macro inserée dans la feuille de travail

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Long
lig = Target.Row
If lig = 1 Then Exit Sub 'non actif sur ligne 1
ActiveSheet.Unprotect Password:="test"
Cells(lig, 12).Locked = Not (Application.CountA(Cells(lig, 1).Resize(1, 8)) = 8)
If Not Intersect(Target, Cells(lig, 2).Resize(1, 7)) Is Nothing Then
If Application.CountA(Cells(lig, 2).Resize(1, 7)) = 7 Then
Cells(lig, 1) = Now()
Else
Cells(lig, 1) = ""
End If
ElseIf Not Intersect(Target, Range("I" & lig)) Is Nothing Then
Cells(lig, 1).Resize(1, 11).Locked = (Cells(lig, 9) <> "")
Cells(lig, 10) = Now()
' Lancement calcul de jours ouvrés
calculJO
End If
ActiveSheet.Protect Password:="test", DrawingObjects:=False, Contents:=True, Scenarios:=False
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

'sub routine interface pour calcul de jours ouvrés
Sub calculJO()

Dim ligne As Range
Dim no_ligne As Integer

For Each ligne In ActiveSheet.UsedRange.Rows
no_ligne = ligne.Row
'appel de la routine de calcul et passage de parametres + affichage du resultat dans colonne K
Columns("K").Rows(no_ligne) = nb_jours_ouvrés(Columns("E").Rows(no_ligne).Value, Columns("G").Rows(no_ligne).Value)
Next


End Sub

' calcul des jours ouvrés (date_début = Columns("E").Rows(no_ligne).Value) et (date_fin = Columns("G").Rows(no_ligne).Value)
Function nb_jours_ouvrés(date_début, date_fin) As Integer
Dim nb_jours_calendaires As Integer
Dim nb_jours_non_ouvrés As Integer
Dim date_i As Integer

' contrôle dates ------------------------------
If Not IsDate(date_début) Then
MsgBox "la date début n'est pas une date "
Exit Function
End If
If Not IsDate(date_fin) Then
MsgBox "la date fin n'est pas une date "
Exit Function
End If
If date_fin < date_début Then
MsgBox "la date fin n'est pas supérieure à la date début "
Exit Function
End If

' nb jours calendaires ------------------------------
nb_jours_calendaires = date_fin - date_début

' détection jours non ouvrés ------------------------------
nb_jours_non_ouvrés = 0
For date_i = date_début To date_fin
If DatePart("w", date_i, vbMonday) = 6 _
Or DatePart("w", date_i, vbMonday) = 7 _
Or date_i = premier_jour_année(Year(date_i)) _
Or date_i = lundi_Paques(Year(date_i)) _
Or date_i = premier_mai(Year(date_i)) _
Or date_i = huit_mai(Year(date_i)) _
Or date_i = jeudi_Ascension(Year(date_i)) _
Or date_i = lundi_Pentecote(Year(date_i)) _
Or date_i = fête_nationale(Year(date_i)) _
Or date_i = onze_novembre(Year(date_i)) _
Or date_i = noël(Year(date_i)) Then
nb_jours_non_ouvrés = nb_jours_non_ouvrés + 1
End If
Next
'---------------------------------------------------------------

' nb jours ouvrés ------------------------------
nb_jours_ouvrés = nb_jours_calendaires - nb_jours_non_ouvrés

End Function


Function premier_jour_année(année As Integer) As String

premier_jour_année = DateSerial(année, 1, 1)

End Function


Function premier_mai(année As Integer) As String

premier_mai = DateSerial(année, 5, 1)

End Function


Function huit_mai(année As Integer) As String

huit_mai = DateSerial(année, 5, 8)

End Function


Function fête_nationale(année As Integer) As String

fête_nationale = DateSerial(année, 7, 14)

End Function


Function onze_novembre(année As Integer) As String

onze_novembre = DateSerial(année, 11, 11)

End Function
Function noël(année As Integer) As String

noël = DateSerial(année, 12, 25)

End Function


Function lundi_Paques(année As Integer) As String

lundi_Paques = DateAdd("d", 1, date_Paques(année))

End Function


Function jeudi_Ascension(année As Integer) As String

jeudi_Ascension = DateAdd("d", 39, date_Paques(année))

End Function


Function lundi_Pentecote(année As Integer) As String

lundi_Pentecote = DateAdd("d", 50, date_Paques(année))

End Function


Function date_Paques(année As Integer) As String

Dim a, b, c, d, e, f, g, h, i, k, l, m, r, mois, jour
a = année Mod 19
b = année \ 100
c = année Mod 100
d = b \ 4
e = b Mod 4
f = (b + 8) \ 25
g = (b - f + 1) \ 3
h = (19 * a + b - d - g + 15) Mod 30
i = c \ 4
k = c Mod 4
l = (32 + 2 * e + 2 * i - h - k) Mod 7
m = (a + 11 * h + 22 * l) \ 451
r = (114 + h + l - 7 * m)
mois = r \ 31
jour = r Mod 31 + 1

date_Paques = DateSerial(année, mois, jour)

End Function
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
19
0
Merci
Bon, cette voie me semblant trop compliquée, je reprends le sujet à la base.
Je clôture ce topic et j'en ouvre un nouveau.

Merci pour l'aide et la patience que les contributeurs dépensent sans compter :)
Messages postés
1771
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
29 juin 2019
351
0
Merci

'sub routine interface pour calcul de jours ouvrés
Sub calculJO()

Dim ligne As Range
Dim no_ligne As Integer

For Each ligne In ActiveSheet.UsedRange.Rows
no_ligne = ligne.Row
'appel de la routine de calcul et passage de parametres + affichage du resultat dans colonne K
If IsDate(Columns("E").Rows(no_ligne).Value) _
And IsDate(Columns("G").Rows(no_ligne).Value) Then
    Columns("K").Rows(no_ligne) = nb_jours_ouvrés(Columns("E").Rows(no_ligne).Value, Columns("G").Rows(no_ligne).Value)
End If
Next

End Sub
tariparau
Messages postés
1
Date d'inscription
mercredi 26 juin 2013
Statut
Membre
Dernière intervention
26 juin 2013
-
bonjour thev,
je ne sais pas si la discussion est toujours ouverte mais voici ma question:
ou doit placer les lignes que tu as créé, je suis nouveau en programmation et j'utilise excel 2003

merci
Messieurs, Bonjour,
Ou je n'ai rien compris au besoin, ou il faudrait utiliser NetworkDays_Intl.
Bonne journée