none
Calcul de date VBA 2010 RRS feed

  • Question

  • Bonjour,

    Je souhaiterais calculer le nombre de jour ouvré entre 2 dates. Mon objectif est de connaitre le nombre de jours entre 2 dates en excluant le week end.

    Quelqu'un peut-il m'aider?

    Je travail avec Excel 2010 en VBA.

    Merci,

    Olivier

    lundi 30 août 2010 14:00

Réponses

  • bonjour Olivier,

    =CalculJoursOuvrés(cellule contenant la date de début;cellule contenant la date de fin)

    Function CalculJoursOuvrés(Déb, Fin)
     For i = Déb * 1 To Fin * 1
      If Weekday(i, vbMonday) < 6 Then x = x + 1
     Next
    CalculJoursOuvrés = x
    End Function
     =CalculJoursOuvrés(cellule contenant la date de début;cellule contenant la date de fin;Plage contenant les jours férier)

    Function CalculJoursOuvrésSansFérier(Déb, Fin, JrFs)
     For i = Déb * 1 To Fin * 1
      If Weekday(i, vbMonday) < 6 Then x = x + 1
      If Not IsError(Application.Match(i, [JrFs], 0)) Then x = x - 1
     Next
    CalculJoursOuvrésSansFérier = x
    End Function
     isabelle

    Le 2010-08-30 10:00, olvier a écrit :

    Bonjour,

    Je souhaiterais calculer le nombre de jour ouvré entre 2 dates. Mon objectif est de connaitre le nombre de jours entre 2 dates en excluant le week end.

    Quelqu'un peut-il m'aider?

    Merci,

    Olivier

    • Marqué comme réponse oliviert74 mardi 31 août 2010 08:08
    lundi 30 août 2010 14:42

Toutes les réponses

  • Bonjour Olivier74,

     

    Voici un exemple de ce que j'utilise quotidiennement.

    Il faut adpater les jours fériés en fonction du pays

    Cdt, Blaise

    Function NbJoursOuvres(DateDebut As Date, DateFin As Date) As Long
    '---------------------------------------------------------------------------------------
    ' Procedure : NbJoursOuvres
    ' Sujet   : Compte le nombre de jours ouvrés entre deux dates, fériés et WE pris en compte
    '---------------------------------------------------------------------------------------
    '
      Dim dtI As Date, Signe As Single
      If DateDebut = DateFin Then
        NbJoursOuvres = 0
        Exit Function
      ElseIf DateDebut > DateFin Then
        Signe = -1
      Else
        Signe = 1
      End If
      For dtI = DateDebut To DateFin Step Signe
        NbJoursOuvres = NbJoursOuvres + (TypeJour(dtI) = 0) * -1
      Next dtI
      NbJoursOuvres = NbJoursOuvres - 1
      NbJoursOuvres = NbJoursOuvres * Signe
    End Function
    
    Function TypeJour(d As Date)
    '---------------------------------------------------------------------------------------
    ' Procedure : TypeJour
    ' Sujet   : Détermine le type de jour
    '---------------------------------------------------------------------------------------
    '
    'Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
    '1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
    'Valide jusqu'en 2099 et pour les jours fériés belges
    
      Dim A As Integer, T As Integer
      Dim LP As Date
    
      A = Year(d)
    
      If A > 2099 Then
        TypeJour = 0
        Exit Function
      End If
    
      T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
      LP = DateSerial(A, 3, 2) + T + (T > 48) + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
    
      Select Case d
        Case LP, LP + 38, LP + 49    ' Jours fériés mobiles
          TypeJour = 2
          ' Jours fériés fixes
        Case DateSerial(A, 1, 1), _
            DateSerial(A, 5, 1), _
            DateSerial(A, 7, 21), _
            DateSerial(A, 8, 15), _
            DateSerial(A, 11, 1), _
            DateSerial(A, 11, 11), _
            DateSerial(A, 12, 25)
          TypeJour = 2
        Case Else
          ' Samedi ou dimanche
          If Weekday(d, vbMonday) >= 6 Then
            TypeJour = 1
          End If
      End Select
    End Function
    
    
    
    • Marqué comme réponse oliviert74 mardi 31 août 2010 08:08
    • Non marqué comme réponse oliviert74 mardi 31 août 2010 08:10
    lundi 30 août 2010 14:39
  • bonjour Olivier,

    =CalculJoursOuvrés(cellule contenant la date de début;cellule contenant la date de fin)

    Function CalculJoursOuvrés(Déb, Fin)
     For i = Déb * 1 To Fin * 1
      If Weekday(i, vbMonday) < 6 Then x = x + 1
     Next
    CalculJoursOuvrés = x
    End Function
     =CalculJoursOuvrés(cellule contenant la date de début;cellule contenant la date de fin;Plage contenant les jours férier)

    Function CalculJoursOuvrésSansFérier(Déb, Fin, JrFs)
     For i = Déb * 1 To Fin * 1
      If Weekday(i, vbMonday) < 6 Then x = x + 1
      If Not IsError(Application.Match(i, [JrFs], 0)) Then x = x - 1
     Next
    CalculJoursOuvrésSansFérier = x
    End Function
     isabelle

    Le 2010-08-30 10:00, olvier a écrit :

    Bonjour,

    Je souhaiterais calculer le nombre de jour ouvré entre 2 dates. Mon objectif est de connaitre le nombre de jours entre 2 dates en excluant le week end.

    Quelqu'un peut-il m'aider?

    Merci,

    Olivier

    • Marqué comme réponse oliviert74 mardi 31 août 2010 08:08
    lundi 30 août 2010 14:42
  • Merci Blaise032 et Isabelle de vos réponses rapide !

    J'utilise la solution d'Isabelle qui me convient parfaitement.

    Merci beaucoup !

    mardi 31 août 2010 08:10