dates excel

tinon · 21 Novembre 2003

j'ai un script qui permet de calculer entre deux dates combien il y a de lundi, mardi, mercredi, jeudi, vendredi, samedi, dimanche ( la formule se pésente sous la forme : nbde(date1;date2;jours de la semaine que l'on cherche lundi étant 1 )mais il ne décompte pas les jours fériés, j'aimerais par exemple que si il y a 3 samedis entre ces deux dates et que l'un d'eux est férié qu'au lieu d'afficher 3 il n'affiche que 2, merci.

Function NbDe(DateDeb As Double, DateFin As Double, Jour As Byte) As Long
'le jour 1 de la semaine est le lundi
Dim i As Double, Deb#, Fin#

If DateDeb <= DateFin Then
Deb = DateDeb: Fin = DateFin
Else
Deb = DateFin: Fin = DateDeb
End If

For i = Int(Deb) To Int(Fin)
If Weekday(i, vbMonday) = Jour Then
NbDe = NbDe + 1
End If
Next i

End Function 'fs

michel · 23 Novembre 2003

bonsoir Tinon

peux tu tester la macro ci dessous et valider si cela fonctionne ou pas . ( je n'ai pas trop eu de temps pour vérifier tous les cas de figures . )

Sub CompterLesJours()
'comptage des jours dans une periode ( hors jours feries )
Dim Debut As Date, Fin As Date, i As Date
Dim LesJours As String
Dim X As Byte, Y As Byte
Dim Tableau(7)

On Error GoTo ErrorHandler

Debut = CDate(InputBox("Date début de période :", , "format :jj/mm/aa"))
Fin = CDate(InputBox("Date fin de période :", , "format :jj/mm/aa"))

For i = Debut To Fin
If Not TYPEJOUR(i) = 2 Then
X = WeekDay(i, vbMonday)
Y = Tableau(X - 1) + 1
Tableau(X - 1) = Y
End If
Next i

LesJours = "Comptage des jours non fériés pour la periode du " & Debut & " au " & Fin & Chr(10) & Chr(10)

For X = 1 To 7
LesJours = LesJours & "nombre de " & Format(Date - ((Date - 2) Mod 7) + X - 1, "dddd") & " " & Tableau(X - 1) & Chr(10)
Next

MsgBox LesJours

ErrorHandler:
End Sub

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

A = Year(D)
If A > 2099 Then
TYPEJOUR = CVErr(xlErrValue)
Exit Function
End If

LD = Int(D) + 1
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

bonne soirée
michel

tinon · 24 Novembre 2003

j'essaye ça et je te tiens au courant, merci.

tinon · 24 Novembre 2003

quelle est la formule à écrire sur la feuille excel pour activer le script, merci.

tinon · 24 Novembre 2003

ça fonctionne mais je vais encore t'embêter, n'y a t il pas moyen de créer la même chose à l'aide d'une fonction et non d'un sub ?

dates excel

tinon

Guest

michel

Guest

tinon

Guest

tinon

Guest

tinon

Guest

Discussions similaires