Calcul de nombre de jours ouvrés VBA EXCEL

Résolu
Eaheru Messages postés 205 Statut Membre -  
 Laurent -
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 !

10 réponses

  1.
    thev Messages postés 2005 Date d'inscription   Statut Membre Dernière intervention   721
     
    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
  2. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    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
  3. Eaheru Messages postés 205 Statut Membre 20
     
    Merci a vous, j'étais absent mais je regarde ça de prés dès cet AM
    0
  4. Eaheru Messages postés 205 Statut Membre 20
     
    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

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

    Posez votre question
  6. Eaheru Messages postés 205 Statut Membre 20
     
    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
  7. thev Messages postés 2005 Date d'inscription   Statut Membre Dernière intervention   721
     
    
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
  8. Eaheru Messages postés 205 Statut Membre 20
     
    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
  9. Eaheru Messages postés 205 Statut Membre 20
     
    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
  10. Eaheru Messages postés 205 Statut Membre 20
     
    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
  11. thev Messages postés 2005 Date d'inscription   Statut Membre Dernière intervention   721
     
    
'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
    1. tariparau Messages postés 2 Date d'inscription   Statut Membre Dernière intervention  
       
      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
    2. Laurent
       
      Messieurs, Bonjour,
      Ou je n'ai rien compris au besoin, ou il faudrait utiliser NetworkDays_Intl.
      Bonne journée
      0

Discussions similaires

Excel formule : nb.si.ens et critère "différent de vide"
lelion4 -
Mick -

11 réponses