date + Nb jours ouvrés

  • Initiateur de la discussion sonskriverez
  • Date de début
S

sonskriverez

Guest
Bonsoir,

J'ai déjà eu pas mal d'aide, mais je coince sur une formulede de calcul de date.
ex : cellule A1 j'ai la date du 13/07/05, je veux ajouter 5 jrs ouvrés et avoir le résultat en B1

et bien sur en VBA

nota: j'ai déjà une plage (feries2005) contenant les jours fériés
 

Bebere

XLDnaute Barbatruc
bonsoir Sonskriverez
avec la fonction typejour de Laurent Longre

Sub Essai()
Dim MaDate As Date
Dim Check As Boolean, Counter As Byte
Check = True: Counter = 0 ' Initialise les variables.

MaDate = Sheets('Feuil1').Range('A1').Value
Do
Do While Counter < 30
Counter = Counter + 1
If TYPEJOUR(MaDate + Counter) = 0 Then j = j + 1
If j = 5 Then

Check = False

Exit Do
End If
Loop
Loop Until Check = False
Sheets('Feuil1').Range('B1').Value = MaDate + j

End Sub
'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 français

Function TYPEJOUR(D As Date)
'L. Longre
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
Dim Toto As Long

A = Year(D)
If A > 2099 Then
TYPEJOUR = CVErr(xlErrValue)
Exit Function
End If
LD = Int(D)
If LD <= 2 Then
If LD = 1 Then TYPEJOUR = 2
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
' Jours fériés mobiles
Case Is = LP, Is = LP + 38, Is = LP + 49
TYPEJOUR = 2
' Jours fériés fixes
Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
TYPEJOUR = 2
Case Else
' Samedi ou dimanche
If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
End Select

End Function

à bientôt
 

Discussions similaires

Réponses
2
Affichages
580

Statistiques des forums

Discussions
312 885
Messages
2 093 255
Membres
105 658
dernier inscrit
Mario Richard