le nombre de fois ou un jour apparait dans une période [Résolu]

Signaler
Messages postés
120
Date d'inscription
jeudi 5 mai 2005
Statut
Membre
Dernière intervention
21 décembre 2017
-
Messages postés
120
Date d'inscription
jeudi 5 mai 2005
Statut
Membre
Dernière intervention
21 décembre 2017
-
je veux avoir le nombre de fois ou un jour apparait dans une période, j'ai un petit programme qui me donne le resultat exacte mais pas quand ce jour que j'ai selectionné est le début du mois de la date de début.
**************************************
'dated est la date de début
'datef est la date fin

Sub cal()
Call Convert
k = 1
nb = 0
While (DateAdd("d", k, Dated)) <= Datef
If (Weekday(DateAdd("d", k, Dated)) = CInt(jour)) Then
nb = nb + 1
End If
k = k + 1
Wend
Txtresult = nb
End Sub
*****************************************
Sub Convert()
Select Case jour
Case "Lundi"
jour = 1
Case "Mardi"
jour = 2
Case "Mercredi"
jour = 3
Case "Jeudi"
jour = 4
Case "Vendredi"
jour = 5
Case "Samedi"
jour = 6
End Select
End sub

alors si qlq1 a une suggestion qu'il me la propose ce code doit obligatoirement marché pour mon programme il constitue a peu prés 70% de mon travail.

Merci d'avance

14 réponses

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
Public Function NbWeekdayInPeriod(ByVal vStartDate As Date, ByVal vEndDate As Date, ByVal vWeekDay As VbDayOfWeek) As Integer
Dim CurrentDate As Date
If vStartDate <= vEndDate Then
CurrentDate = vStartDate
Do
If WeekDay(CurrentDate) = vWeekDay Then
NbWeekdayInPeriod = NbWeekdayInPeriod + 1
End If
CurrentDate = DateAdd("d", 1, CurrentDate)
Loop While CurrentDate < vEndDate
End If
End Function

Amusez-vous !
Renfield - thomas_reynald@msn.com
Admin CodeS-SourceS - MVP Visual Basic
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 195 internautes nous ont dit merci ce mois-ci

Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
41
re,
j'ai juste enlevé la ligne remarquée par Gwoui2, le code est correct. 5 samedi...
tu t'es peut-être trompée en écrivant la date (#mm/dd/yyyy#)


Option Explicit
'
'
Dim DateD As Date
Dim DateF As Date
'
'
Private Sub Form_Load()
DateD = #10/1/2005# ' 1 oct
DateF = #10/31/2005# '31 oct

Dim sJour As String: sJour = "samedi"

Dim Ret As Long
Ret = FindNbDay(DateD, DateF, ConvDayInNumber(sJour))
If Ret = -1 Then
MsgBox "Jour non-valide!", 32
ElseIf Ret = -2 Then
MsgBox "Dates non-valides!", 32
Else
MsgBox "Il y a " & Ret & " " & sJour & " dans votre période.", 32
End If

Unload Me
End Sub
'
'
Private Function FindNbDay(dDateDebut As Date, dDateFin As Date, iDay As Integer) As Long If iDay 0 Then FindNbDay -1: Exit Function If dDateFin <dDateDebut Then FindNbDay -2: Exit Function

Dim lCpt As Long: lCpt = 0

While (dDateDebut <= dDateFin) If ( Weekday (dDateDebut) iDay) Then lCpt lCpt + 1
dDateDebut = dDateDebut + 1
Wend

FindNbDay = lCpt
End Function
'
'
Private Function ConvDayInNumber(sDay As String) As Integer
Select Case LCase (sDay)
Case "lundi": ConvDayInNumber = 2
Case "mardi": ConvDayInNumber = 3
Case "mercredi": ConvDayInNumber = 4
Case "jeudi": ConvDayInNumber = 5
Case "vendredi": ConvDayInNumber = 6
Case "samedi": ConvDayInNumber = 7
Case Else: ConvDayInNumber = 0
End Select
End Function


<SMALL> Coloration syntaxique automatique [AFCK]</SMALL>


PCPT
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 195 internautes nous ont dit merci ce mois-ci

Messages postés
9
Date d'inscription
jeudi 17 juin 2004
Statut
Membre
Dernière intervention
29 octobre 2005

J'ai vu 2 erreurs dans ton programme :
- par défaut , la fonction Weekday commence au dimanche. Donc en fait tu comptes ici les dimanches au lieu des lundis, les lundis au lieu des mardis...
Pour corriger le problème, il suffit d'indiquer que Lundi est le premier jour de la semaine :
Weekday(DateAdd("d", k, Dated), vbMonday)
- tu initialises le programme avec k 1, donc le premier jour de la plage n'est pas testé ! Il faut donc k 0

Ces 2 points devraient résoudre ton problème.
Par contre, pour éviter des erreurs et rendre le programme plus propre, il serait bien de déclarer les variables, et d'éviter d'utiliser la même variable (jour) successivement pour 2 notions différentes (jour en lettres puis numéro).
Messages postés
338
Date d'inscription
mardi 28 janvier 2003
Statut
Membre
Dernière intervention
4 novembre 2008
1
commence par k=0

Hassen TUNISIE
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
41
salut,

tiens, çà me semble OK :


Option Explicit
'
'
Dim DateD As Date
Dim DateF As Date
'
'
Private Sub Form_Load()
DateD = #4/10/2005# '10 avril
DateF = #9/15/2005# '15 sept
' DateD = #10/3/2005#
' DateF = #10/10/2005#

Dim sJour As String: sJour = "lundi"

Dim Ret As Long
Ret = FindNbDay(DateD, DateF, ConvDayInNumber(sJour))
If Ret = -1 Then
MsgBox "Jour non-valide!", 32
ElseIf Ret = -2 Then
MsgBox "Dates non-valides!", 32
Else
MsgBox "Il y a " & Ret & " " & sJour & " dans votre période.", 32
End If

Unload Me
End Sub
'
'
Private Function FindNbDay(dDateDebut As Date, dDateFin As Date, iDay As Integer) As Long If iDay 0 Then FindNbDay -1: Exit Function If dDateFin <dDateDebut Then FindNbDay -2: Exit Function

Dim lCpt As Long: lCpt = 0
'permier jour If ( Format (dDateDebut, "DDDD") iDay) Then lCpt 1

While (dDateDebut <= dDateFin) If ( Weekday (dDateDebut) iDay) Then lCpt lCpt + 1
dDateDebut = dDateDebut + 1
Wend

FindNbDay = lCpt
End Function
'
'
Private Function ConvDayInNumber(sDay As String) As Integer
Select Case LCase (sDay)
Case "lundi": ConvDayInNumber = 2
Case "mardi": ConvDayInNumber = 3
Case "mercredi": ConvDayInNumber = 4
Case "jeudi": ConvDayInNumber = 5
Case "vendredi": ConvDayInNumber = 6
Case "samedi": ConvDayInNumber = 7
Case Else: ConvDayInNumber = 0
End Select
End Function


<SMALL> Coloration syntaxique automatique [AFCK]</SMALL>


++
ps : 70% du boulot?
vous être plusieurs?
PCPT
Messages postés
9
Date d'inscription
jeudi 17 juin 2004
Statut
Membre
Dernière intervention
29 octobre 2005

Re salut

Ah ça fait plaisir de voir du plus beau code ! J'avais pas eu le courage...

Par contre, ton test premier jour est inutile et incorrect :
'permier jour If (Format(dDateDebut, "DDDD") iDay) Then lCpt 1
en effet, le test sur le premier jour est fait dans le while, et ton if ne risque pas d'être vrai puisque tu compares un string ("lundi") à un integer (iDay=2).
Donc on peut supprimer cette ligne, et tout fonctionnera toujours bien.
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
41
re,
en effet, il aurait fallut lireIf (ConvDayInNumber(Format(dDateDebut, "DDDD")) iDay) Then lCpt 1
et qui a été ajouté parce que plusieurs tests.....
ligne en effet inutile. merci de ta rectification

PCPT
Messages postés
120
Date d'inscription
jeudi 5 mai 2005
Statut
Membre
Dernière intervention
21 décembre 2017

Bonjour les amis désolé pour mon retard la cause c'est que j'ai pas internet a la maison c'est pourquoi j'attend l'heure du travail je tiens à vous remercié tous pour votre aide et maintenant je suis entrain de faire des tests sur ton programme pcpt, je t'en donnerai des nouvelles lorsque je terminerai de torturer ton prog avec mes tests merci encore.
Messages postés
120
Date d'inscription
jeudi 5 mai 2005
Statut
Membre
Dernière intervention
21 décembre 2017

resalut, j'ai pu le testé malheureusement le problème c'est que par exemple quand je prend le jour samedi il est le premier jour du mois d'octobre alors du 01/10/2005 au 31/10/2005 y'en a 5 samedi ton programme indique 6, aprés d'autre essai quand je selectionne un jour et que ce jour là soit le premier jour du mois sa en rajoute 1, si c'est possible de me rectifier ce petit bug et merci d'avance.
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
41
salut RenFied
MsgBox NbWeekdayInPeriod(DateD, DateF, vbSaturday) retourne 0 pour 1 au 31 oct 2005
PCPT
Messages postés
120
Date d'inscription
jeudi 5 mai 2005
Statut
Membre
Dernière intervention
21 décembre 2017

Merci bien pour votre aide c'est bien rassurant de voir qu'il y a des amis qui nous soutiennent lorsqu'on a besoin d'eux Merci encore.
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
J'ai bien 5... en faisant :

NbWeekdayInPeriod(#10/1/2005#, #10/31/2005#, vbSaturday)

Amusez-vous !
Renfield - thomas_reynald@msn.com
Admin CodeS-SourceS - MVP Visual Basic
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
41
re,
en effet, c'est quand je remplace DateD et DateF, en plaçant ta fonction après la mienne.

Kokise -> il faut modifier mon entête de fonction FindNbDay ByVal si tu la gardes

Private Function FindNbDay(ByVal dDateDebut As Date, ByVal dDateFin As Date, iDay As Integer)

PCPT
Messages postés
120
Date d'inscription
jeudi 5 mai 2005
Statut
Membre
Dernière intervention
21 décembre 2017

Ok je n'oublierai pas de la modifer et merci pour votre attention. A bientôt.