Salut
Suite à nettoyage d'un disque dur ancien, avant de le jeter, un code qui pourrait être utile.
2 codes complémentaires, recherche de dates pour un nom de jour de la semaine sur une période définie.
Année en cours définie par la date de départ à fin de la même l'année
de date de départ à date de départ plus un an
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50 'Numéro du jour par apport à son nom '0=Dimanche, 1=Lundi,.....,6=Samedi Option explicit Dim T ' indice pour les boucles Dim NumJourRechercher: NumJourRechercher = 3 ' 3 pour Mardi, numéro nom du jour a rechercher Dim TblDateRechercher() ' tableau qui contiendra les dates du jour de la semaine a rechercher Dim DatePremierJour: DatePremierJour = now ' ici on prend la date du jour Dim AnnEnCours: AnnEnCours = Year(DatePremierJour) If Weekday(DatePremierJour) <> NumJourRechercher Then 'premiére boucle pour trouver le premier mardi suivant la date du jour For T=1 To 6 If Weekday(DateAdd("d", 1, DatePremierJour+T)) = NumJourRechercher and Year(DatePremierJour) = AnnEnCours Then 'DatePremierJour+T est un mardi, retient la date Redim TblDateRechercher(1)'agrandi la variable tableau en conservant les données des indices déjà existants TblDateRechercher(0)= FormatDateTime(DateAdd("d", 1, DatePremierJour+T),2) Exit For ' sortie de la boucle End If Next Else 'la date du premier jour est un mardi, retient la date TblDateRechercher(0)= DateAdd("d", 1, DatePremierJour) End If 'boucle sur le restant de l'année en cours Dim DateBoucle2: DateBoucle2 = Cdate(TblDateRechercher(0))+7 Dim DatePlus1An: DatePlus1An = Cdate(FormatDateTime(DateAdd("yyyy",1,DatePremierJour),2)) 'msgbox DatePlus1An For T = DateBoucle2 To DatePlus1An step 7 If Year(T) = AnnEnCours Then 'msgbox Ubound(TblDateRechercher) Redim Preserve TblDateRechercher(Ubound(TblDateRechercher)+1) 'msgbox Ubound(TblDateRechercher) TblDateRechercher(Ubound(TblDateRechercher)-1)=T Else 'si Year(T) <> AnnEnCours Exit For End If 'msgbox T Next 'TblDateRechercher contient maintenant la totalitée des dates recherchées, correspondant au nom du jour de la semaine 'Vérification msgbox "il y a " & Ubound(TblDateRechercher) & " mardi(s) d'ici la fin de l'année en cours" Dim U: U=Ubound(TblDateRechercher) For T = 0 to Ubound(TblDateRechercher)-1 msgbox TblDateRechercher(t)& " date " & (T+1) & " sur " & U Next
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 'Numéro du jour par apport à son nom '0=Dimanche, 1=Lundi,.....,6=Samedi Option explicit Dim T ' indice pour les boucles Dim NumJourRechercher: NumJourRechercher = 3 ' 3 pour Mardi, numéro nom du jour a rechercher Dim TblDateRechercher() ' tableau qui contiendra les dates du jour a rechercher Dim DatePremierJour: DatePremierJour = now ' ici on prend la date du jour Dim AnnEnCours: AnnEnCours = Year(DatePremierJour) If Weekday(DatePremierJour) <> NumJourRechercher Then 'premiére boucle pour trouver le premier mardi suivant la date du jour For T=1 To 6 If Weekday(DateAdd("d", 1, DatePremierJour+T)) = NumJourRechercher Then 'DatePremierJour+T est un mardi, retient la date Redim TblDateRechercher(1)'agrandi la variable tableau en conservant les données des indices déjà existants TblDateRechercher(0)= FormatDateTime(DateAdd("d", 1, DatePremierJour+T),2) Exit For ' sortie de la boucle End If Next Else 'la date du premier jour est un mardi, retient la date TblDateRechercher(0)= DateAdd("d", 1, DatePremierJour) End If 'boucle sur le restant de l'année en cours Dim DateBoucle2: DateBoucle2 = Cdate(TblDateRechercher(0))+7 Dim DatePlus1An: DatePlus1An = Cdate(FormatDateTime(DateAdd("yyyy",1,DatePremierJour),2)) 'msgbox DatePlus1An For T = DateBoucle2 To DatePlus1An step 7 'msgbox Ubound(TblDateRechercher) Redim Preserve TblDateRechercher(Ubound(TblDateRechercher)+1) 'msgbox Ubound(TblDateRechercher) TblDateRechercher(Ubound(TblDateRechercher)-1)=T Next 'TblDateRechercher contient maintenant la totalitée des dates recherchées, correspondant au nom du jour de la semaine 'Vérification msgbox "il y a " & Ubound(TblDateRechercher) & " mardi(s) d'ici la fin de l'année" Dim U: U=Ubound(TblDateRechercher) For T = 0 to Ubound(TblDateRechercher)-1 msgbox TblDateRechercher(t)& " date " & (T+1) & " sur " & U Next
Partager