Sujet Précédent Sujet Suivant

Calcul de nombre de jours ouvrés VBA EXCEL

Résolu/Fermé
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 - Modifié par Eaheru le 29/06/2010 à 17:34
 Laurent - 11 août 2016 à 13:29
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 !
A voir également:

10 réponses

Réponse 1 / 10
thev Messages postés 1955 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 13 février 2025 700
30 juin 2010 à 10:33
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
2
Réponse 2 / 10
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 252
Modifié par eriiic le 29/06/2010 à 22:35
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
1
Réponse 3 / 10
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
1 juil. 2010 à 11:55
Merci a vous, j'étais absent mais je regarde ça de prés dès cet AM
0
Réponse 4 / 10
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
5 juil. 2010 à 17:28
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 :)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 10
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
5 juil. 2010 à 17:34
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.
0
Réponse 6 / 10
thev Messages postés 1955 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 13 février 2025 700
5 juil. 2010 à 19:12 

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
0
Réponse 7 / 10
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
6 juil. 2010 à 15:13
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 ^^
0
Réponse 8 / 10
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
Modifié par Eaheru le 6/07/2010 à 16:04
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
0
Réponse 9 / 10
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
7 juil. 2010 à 16:11
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 :)
0
Réponse 10 / 10
thev Messages postés 1955 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 13 février 2025 700
7 juil. 2010 à 19:31 

'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
0
tariparau Messages postés 1 Date d'inscription mercredi 26 juin 2013 Statut Membre Dernière intervention 26 juin 2013
Modifié par tariparau le 26/06/2013 à 09:21
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
0
Laurent
11 août 2016 à 13:29
Messieurs, Bonjour,
Ou je n'ai rien compris au besoin, ou il faudrait utiliser NetworkDays_Intl.
Bonne journée
0