VBA PB n° de semaine

Arpette · 1 Août 2010

Bonjour le forum, j'ai un problème avec mon n° de semaine. Nous somme le 1/08/2010 et en semaine 31, ma formule affiche 30. Je ne comprends pas.Ci-joint mon code.
Merci de votre aide

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False

Dim Sme As Byte

Sme = DatePart("ww", Date, 2, 2)
Cells(1, 1) = "Semaine n° " & Sme

datedep = CDate("1/1/" & Year(Date))
For D = datedep To CDate("1/1/" & Year(Date) + 1)
If DatePart("ww", D, 2, 2) = Sme Then
Cells(2, 1) = "Du " & D & " au " & D + 6
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub

youky(BJ) · 1 Août 2010

Re : VBA PB n° de semaine

Salut Arpette,
Sme = DatePart("ww", Date, 1, 2)
1 au lieu de 2
En VBA mets ton curseur sur DatePart et presse [F1] tu auras les explications.
Bruno

Arpette · 1 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:
Salut Arpette,
Sme = DatePart("ww", Date, 1, 2)
1 au lieu de 2
En VBA mets ton curseur sur DatePart et presse [F1] tu auras les explications.
Bruno

Salut Bruno et merci de ton aide,
j'ai écrit ceci, çà a l'air de marcher A1 = 31 et
A2 = du 01//08/2010 au 07/08/2010

Tu penses que c'est bon?
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False

Dim Sme As Byte

Sme = DatePart("ww", Date, 1, 2)
Cells(1, 1) = "Semaine n° " & Sme

datedep = CDate("1/1/" & Year(Date))
For D = datedep To CDate("1/1/" & Year(Date) + 1)
If DatePart("ww", Date, 1, 2) = Sme Then
Cells(2, 1) = "Du " & Date & " au " & Date + 6
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub

youky(BJ) · 1 Août 2010

Re : VBA PB n° de semaine

Re,
Pour écrire seulement dans 2 cellules le ScreenUpdating est superflu.
Le 1 désigne que la semaine commence le dimanche, sur le calendrier des PTT
qu'ils distribuent pour leurs étrennes, les semaines partent du Lundi mais à toi de voir
sinon rien à redire d'autres.
Bruno

Arpette · 1 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:
Re,
Pour écrire seulement dans 2 cellules le ScreenUpdating est superflu.
Le 1 désigne que la semaine commence le dimanche, sur le calendrier des PTT
qu'ils distribuent pour leurs étrennes, les semaines partent du Lundi mais à toi de voir
sinon rien à redire d'autres.
Bruno

Re, ok merci Bruno.
@+

ROGER2327 · 2 Août 2010

Re : VBA PB n° de semaine

Bonjour à tous

Le problème est que la fonction DatePart("ww", Date, 1, 2) est assez capricieuse. Par exemple, si Date est 29/12/1991, elle renvoie 53 au lieu du 52 attendu.
On ne peut donc l'utiliser que pour certaines dates, ce qui est assez ennuyeux...
Il me semble que vous pourriez obtenir le résultat correct avec l'une des trois procédures suivantes, selon le système que vous souhaitez employer.

Système international défini par la norme ISO 8601 (recommandé) :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate()[COLOR="SeaGreen"] 'Norme internationale ISO 8601 :
'La semaine débute le lundi et s'achève le dimanche.
'La première semaine de l'année est celle qui contient le premier jeudi de janvier.[/COLOR]
Dim d As Date, j As Date
   d = Date
   j = d + 1 - DatePart("w", d, vbMonday, vbFirstFourDays)
   Cells(1, 1) = "Semaine n° " & DatePart("ww", j + 1, vbMonday, vbFirstFourDays)
   Cells(2, 1) = "Du " & Format(j, "ddd dd-mm-yyyy") & " au " & Format(j + 6, "ddd dd-mm-yyyy")
End Sub[/B][/COLOR]

Système étatsunien d'Amérique du Nord :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate() [COLOR="SeaGreen"]'Norme locale étatsunienne d'Amérique du Nord :
'Les semaines débutent le dimanche, sauf la première de l'année qui commence le premier janvier quel que soit le jour.
'Les semaines s'achèvent le samedi, sauf la dernière de l'année qui s'achève le 31 décembre quel que soit le jour.[/COLOR]
Dim d As Date, d0 As Date, d1 As Date, d2 As Date
   d = Date
   d0 = d + 1 - DatePart("w", d, vbSunday, vbFirstJan1)
   d1 = WorksheetFunction.Max(d0, DateSerial(Year(d), 1, 1))
   d2 = WorksheetFunction.Min(d0 + 6, DateSerial(Year(d), 12, 31))
   Cells(1, 1) = "Semaine n° " & DatePart("ww", d, vbSunday, vbFirstJan1)
   Cells(2, 1) = "Du " & Format(d1, "ddd dd-mm-yyyy") & " au " & Format(d2, "ddd dd-mm-yyyy")
End Sub[/B][/COLOR]

C'est assez folklorique puisque dans ces régions la semaine est une période variable de un à sept jours. Par exemple :
Sem.n° 53 de 2010 : Du dim. 26-12-2010 au ven. 31-12-2010 (6 jours)
Sem.n° 01 de 2011 : Du sam. 01-01-2011 au sam. 01-01-2011 (1 jour)
Sem.n° 53 de 2012 : Du dim. 30-12-2012 au lun. 31-12-2012 (2 jours)

Système hors norme de Arpette :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate() [COLOR="SeaGreen"]'Système particulier de Arpette :
'La semaine débute le dimanche et s'achève le samedi.
'La première semaine de l'année est celle qui contient le premier mercredi de janvier.[/COLOR]
Dim d As Date, j As Date
   d = Date
   j = d + 1 - DatePart("w", d, vbSunday, vbFirstFourDays)
   Cells(1, 1) = "Semaine n° " & DatePart("ww", j + 1, vbSunday, vbFirstFourDays)
   Cells(2, 1) = "Du " & Format(j, "ddd dd-mm-yyyy") & " au " & Format(j + 6, "ddd dd-mm-yyyy")
End Sub[/B][/COLOR]

On y trouve des semaines commençant le dimanche, comme dans le système étatsuniens d'Amérique du Nord, et des semaines invariables de sept jours comme dans le système international.

Les trois systèmes donnent parfois trois résultats différents.
Par exemple, le dimanche 3 janvier 2010 (date ISO 2009W53-7) fait partie de la semaine

53 de 2009 dans le système international ;
02 de 2010 dans le sytème étatsuniens d'Amérique du Nord;
01 de 2010 dans le système particulier de Arpette

Le classeur joint permet de tester les différents systèmes grâce à quelques fonctions personnalisées.

ROGER2327
#3990

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T02:42:49Z

Arpette · 2 Août 2010

Re : VBA PB n° de semaine

ROGER2327 à dit:
Bonjour à tous
Le problème est que la fonction DatePart("ww", Date, 1, 2) est assez capricieuse. Par exemple, si Date est 29/12/1991, elle renvoie 53 au lieu du 52 attendu.
On ne peut donc l'utiliser que pour certaines dates, ce qui est assez ennuyeux...
Il me semble que vous pourriez obtenir le résultat correct avec l'une des trois procédures suivantes, selon le système que vous souhaitez employer.

Système international défini par la norme ISO 8601 (recommandé) :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate()[COLOR="SeaGreen"] 'Norme internationale ISO 8601 : 'La semaine débute le lundi et s'achève le dimanche. 'La première semaine de l'année est celle qui contient le premier jeudi de janvier.[/COLOR] Dim d As Date, j As Date d = Date j = d + 1 - DatePart("w", d, vbMonday, vbFirstFourDays) Cells(1, 1) = "Semaine n° " & DatePart("ww", j + 1, vbMonday, vbFirstFourDays) Cells(2, 1) = "Du " & Format(j, "ddd dd-mm-yyyy") & " au " & Format(j + 6, "ddd dd-mm-yyyy") End Sub[/B][/COLOR]

Système étatsunien d'Amérique du Nord :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate() [COLOR="SeaGreen"]'Norme locale étatsunienne d'Amérique du Nord : 'Les semaines débutent le dimanche, sauf la première de l'année qui commence le premier janvier quel que soit le jour. 'Les semaines s'achèvent le samedi, sauf la dernière de l'année qui s'achève le 31 décembre quel que soit le jour.[/COLOR] Dim d As Date, d0 As Date, d1 As Date, d2 As Date d = Date d0 = d + 1 - DatePart("w", d, vbSunday, vbFirstJan1) d1 = WorksheetFunction.Max(d0, DateSerial(Year(d), 1, 1)) d2 = WorksheetFunction.Min(d0 + 6, DateSerial(Year(d), 12, 31)) Cells(1, 1) = "Semaine n° " & DatePart("ww", d, vbSunday, vbFirstJan1) Cells(2, 1) = "Du " & Format(d1, "ddd dd-mm-yyyy") & " au " & Format(d2, "ddd dd-mm-yyyy") End Sub[/B][/COLOR]

C'est assez folklorique puisque dans ces régions la semaine est une période variable de un à sept jours. Par exemple :
Sem.n° 53 de 2010 : Du dim. 26-12-2010 au ven. 31-12-2010 (6 jours)
Sem.n° 01 de 2011 : Du sam. 01-01-2011 au sam. 01-01-2011 (1 jour)
Sem.n° 53 de 2012 : Du dim. 30-12-2012 au lun. 31-12-2012 (2 jours)

Système hors norme de Arpette :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate() [COLOR="SeaGreen"]'Système particulier de Arpette : 'La semaine débute le dimanche et s'achève le samedi. 'La première semaine de l'année est celle qui contient le premier mercredi de janvier.[/COLOR] Dim d As Date, j As Date d = Date j = d + 1 - DatePart("w", d, vbSunday, vbFirstFourDays) Cells(1, 1) = "Semaine n° " & DatePart("ww", j + 1, vbSunday, vbFirstFourDays) Cells(2, 1) = "Du " & Format(j, "ddd dd-mm-yyyy") & " au " & Format(j + 6, "ddd dd-mm-yyyy") End Sub[/B][/COLOR]

On y trouve des semaines commençant le dimanche, comme dans le système étatsuniens d'Amérique du Nord, et des semaines invariables de sept jours comme dans le système international.

Les trois systèmes donnent parfois trois résultats différents.
Par exemple, le dimanche 3 janvier 2010 (date ISO 2009W53-7) fait partie de la semaine

53 de 2009 dans le système international ;
02 de 2010 dans le sytème étatsuniens d'Amérique du Nord;
01 de 2010 dans le système particulier de Arpette
Le classeur joint permet de tester les différents systèmes grâce à quelques fonctions personnalisées.
ROGER2327
#3990

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T02:42:49Z

Bonjour à tous et merci Roger pour ton explication. J'ai une autre question concernant la semaine 53. Je souhaite afficher dans une cellule le mois encours. Mais si je me mais au 31/12/2009 çà me renvoi Décembre et je souhaiterais que ce soit Janvier.
Merci de votre aide

ROGER2327 · 2 Août 2010

Re : VBA PB n° de semaine

Re...

Format(j + 3, "mmmm") donne le nom du mois qui contient au moins quatre jours de la semaine.
Par exemple :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate() [COLOR="SeaGreen"]'Système particulier de Arpette :
'La semaine débute le dimanche et s'achève le samedi.
'La première semaine de l'année est celle qui contient le premier mercredi de janvier.[/COLOR]
Dim d As Date, j As Date
   d = Cells(4, 1).Value 'Date
   j = d + 1 - DatePart("w", d, vbSunday, vbFirstFourDays)
   Cells(1, 1) = "Semaine n° " & DatePart("ww", j + 1, vbSunday, vbFirstFourDays)
   Cells(2, 1) = "Du " & Format(j, "ddd dd-mm-yyyy") & " au " & Format(j + 6, "ddd dd-mm-yyyy")
   [COLOR="Red"]Cells(3, 1) = Format(j + 3, "mmmm")[/COLOR] [COLOR="SeaGreen"]'mois contenant au moins 4 jours de la semaine.[/COLOR]
End Sub[/B][/COLOR]

ROGER2327
#3992

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T10:42:41Z

Arpette · 2 Août 2010

Re : VBA PB n° de semaine

ROGER2327 à dit:

Re...

Format(j + 3, "mmmm") donne le nom du mois qui contient au moins quatre jours de la semaine.
Par exemple :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Activate() [COLOR="SeaGreen"]'Système particulier de Arpette :
'La semaine débute le dimanche et s'achève le samedi.
'La première semaine de l'année est celle qui contient le premier mercredi de janvier.[/COLOR]
Dim d As Date, j As Date
   d = Cells(4, 1).Value 'Date
   j = d + 1 - DatePart("w", d, vbSunday, vbFirstFourDays)
   Cells(1, 1) = "Semaine n° " & DatePart("ww", j + 1, vbSunday, vbFirstFourDays)
   Cells(2, 1) = "Du " & Format(j, "ddd dd-mm-yyyy") & " au " & Format(j + 6, "ddd dd-mm-yyyy")
   [COLOR="Red"]Cells(3, 1) = Format(j + 3, "mmmm")[/COLOR] [COLOR="SeaGreen"]'mois contenant au moins 4 jours de la semaine.[/COLOR]
End Sub[/B][/COLOR]

ROGER2327
#3992

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T10:42:41Z

Merci Roger, çà fonctionne, mais maintenant c'est l'année 2009 au lieu de 2010. D'autre part pour les semaines j'ai pris la norme iso. Cà fonctionne bien avec semaine 53, mais au mois d'Août il comme à la semaine 30.
Voici ce que j'ai écrit.
Sheets("Relevé_Hebdo").Select
Worksheets("Relevé_Hebdo").Unprotect
Mois = Format(j + 3, "mmmm")
Année = Format(Now, "yyyy")

Titre = "MOIS DE" & " " & Mois & " " & Année
Cells(1, 1) = UCase(Titre)

For Each c In Range("C1,E1,G1,I1,K1")

j = d + 1 - DatePart("w", d, vbMonday, vbFirstFourDays)
c = "Sme" & " " & DatePart("ww", DateDepart, vbMonday, vbFirstFourDays)
DateDepart = DateDepart + 7 'Incrémente la date de 7 jours (1 semaine)
Next
Worksheets("Relevé_Hebdo").Protect
End If
Application.ScreenUpdating = True
End Sub

Merci de ton aide.

youky(BJ) · 2 Août 2010

Re : VBA PB n° de semaine

Bonjour Arpette, Roger,
Peut être voir à remplacer vbMonday par vbsunday,
Pour ma part je n'utilise pas "DatePart" mais ce code que j'ai depuis 10ans
Bon d'accord il est un peu vieux jeu . . . .
Bruno

Code:

D=Date  
D = Int(D)
   ns = DateSerial(Year(D + (8 - WeekDay(D)) Mod 7 - 3), 1, 1)
   ns = ((D - ns - 3 + (WeekDay(ns) + 1) Mod 7)) \ 7 + 1
MsgBox ns

ROGER2327 · 2 Août 2010

Re : VBA PB n° de semaine

Bonjour youky(BJ)

youky(BJ) à dit:
Bonjour Arpette, Roger,
Peut être voir à remplacer vbMonday par vbsunday,
Pour ma part je n'utilise pas "DatePart" mais ce code que j'ai depuis 10ans
Bon d'accord il est un peu vieux jeu . . . .
Bruno

Code:

D=Date D = Int(D) ns = DateSerial(Year(D + (8 - WeekDay(D)) Mod 7 - 3), 1, 1) ns = ((D - ns - 3 + (WeekDay(ns) + 1) Mod 7)) \ 7 + 1 MsgBox ns

J'utilise également cette technique car je n'aime pas la fonction DatePart, trop aléatoire. En fait, j'utilise surtout ceci :

Code:

[COLOR="DarkSlateGray"][B]Function SEM(d As Date) As String
Application.Volatile
Dim ns&
   d = Int(d)
   ns = DateSerial(Year(d + (8 - Weekday(d, vbSunday)) Mod 7 - 3), 1, 1)
   ns = ((d - ns - 3 + (Weekday(ns, vbSunday) + 1) Mod 7)) \ 7 + 1
   SEM = Year(d) - (ns > 50) * (Month(d) = 1) + (ns < 5) * (Month(d) = 12) & "-W" & Right$("0" & ns, 2)
End Function[/B][/COLOR]

car j'estime qu'un numéro de semaine sans son année de référence n'a pas grand sens.

ROGER2327
#3994

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T15:11:07Z

Arpette · 2 Août 2010

Re : VBA PB n° de semaine

youky(BJ) à dit:
Bonjour Arpette, Roger,
Peut être voir à remplacer vbMonday par vbsunday,
Pour ma part je n'utilise pas "DatePart" mais ce code que j'ai depuis 10ans
Bon d'accord il est un peu vieux jeu . . . .
Bruno

Code:

D=Date D = Int(D) ns = DateSerial(Year(D + (8 - WeekDay(D)) Mod 7 - 3), 1, 1) ns = ((D - ns - 3 + (WeekDay(ns) + 1) Mod 7)) \ 7 + 1 MsgBox ns

Bonsoir à tous, je n'arrive toujours pas à renvoyer l'année 2010 dans le cas de la semaine 53. J'ai bien Janvier mais 2009 et non 2010. De plus dans ma feuille "Relevé_Hebdo" dans mes cellules C1,E1,I1,E1,K1 le programme renvoi toujours la même semaine. Je vous joints mon fichier.

Merci de votre aide

ROGER2327 · 2 Août 2010

Re : VBA PB n° de semaine

Re..

Arpette à dit:
Merci Roger, çà fonctionne, mais maintenant c'est l'année 2009 au lieu de 2010. D'autre part pour les semaines j'ai pris la norme iso. Cà fonctionne bien avec semaine 53, mais au mois d'Août il comme à la semaine 30.
(...)

Pourriez-vous donner des exemples où vous avez 2009 au lieu de 2010, car je ne vois pas bien dans quel cas vous avez un problème.
Quant aux numéros de semaines selon la norme ISO pour le mois d'aôut 2010, ce sont :
30 Du lun. 26-07-2010 au dim. 01-08-2010
31 Du lun. 02-08-2010 au dim. 08-08-2010
32 Du lun. 09-08-2010 au dim. 15-08-2010
33 Du lun. 16-08-2010 au dim. 22-08-2010
34 Du lun. 23-08-2010 au dim. 29-08-2010
35 Du lun. 30-08-2010 au dim. 05-09-2010

Bon courage.
ROGER2327
#3995

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T15:20:29Z

Note : Je n'avais pas vu votre précédent message quand j'ai écrit celui-ci.
Je vais y regarder et je reviendrai plus tard (je dois m'absenter un moment).

Arpette · 2 Août 2010

Re : VBA PB n° de semaine

ROGER2327 à dit:
Re..
Pourriez-vous donner des exemples où vous avez 2009 au lieu de 2010, car je ne vois pas bien dans quel cas vous avez un problème.
Quant aux numéros de semaines selon la norme ISO pour le mois d'aôut 2010, ce sont :
30 Du lun. 26-07-2010 au dim. 01-08-2010
31 Du lun. 02-08-2010 au dim. 08-08-2010
32 Du lun. 09-08-2010 au dim. 15-08-2010
33 Du lun. 16-08-2010 au dim. 22-08-2010
34 Du lun. 23-08-2010 au dim. 29-08-2010
35 Du lun. 30-08-2010 au dim. 05-09-2010

Bon courage.
ROGER2327
#3995

Vendredi 20 Tatane 137 (Saint Tiberge, frère quêteur, SQ)
15 Thermidor An CCXVIII
2010-W31-1T15:20:29Z

Note : Je n'avais pas vu votre précédent message quand j'ai écrit celui-ci.
Je vais y regarder et je reviendrai plus tard (je dois m'absenter un moment).

Re, à tous quelqu'un à une idée ?
Merci de m'aider.

ROGER2327 · 3 Août 2010

Re : VBA PB n° de semaine

Re...

Je dois dire que j'ai un peu de mal à vous suivre car, si vous utilisez le calendrier ISO, vous ne pourrez pas avoir de référence exacte aux mois du calendrier grégorien (la notion de mois n'existe pas dans le calendrier ISO).
En pratique, les semaines extrêmes couvrant un mois du calendrier grégorien "débordent" généralement sur le mois précédent et le mois suivant. C'est le cas pour le mois d'août 2010, puisque la semaine contenant le premier août débute le 26 juillet, et la semaine contenant le 31 août s'achève le 5 septembre.

Il n'y a qu'en février, certaines années, que la correspondance peut être exacte. Par exemple en 2010 :
2010W05-1 Sem.n° 05 Du lun. 01-02-2010 au dim. 07-02-2010
2010W06-1 Sem.n° 06 Du lun. 08-02-2010 au dim. 14-02-2010
2010W07-1 Sem.n° 07 Du lun. 15-02-2010 au dim. 21-02-2010
2010W08-1 Sem.n° 08 Du lun. 22-02-2010 au dim. 28-02-2010

Pour ce qui est de votre classeur, je ne peux l'étudier : je prends quelques jours de vacances à compter d'aujourd'hui. J'espère que d'autres vous donneront un coup de main...
À plus tard, donc, et bon courage.

ROGER2327
#3997

Samedi 21 Tatane 137 (Saints Catoblepas, lord et Anoblepas, amirals, SQ)
16 Thermidor An CCXVIII
2010-W31-2T00:53:22Z

Effectuez une recherche sur Excel Downloads...

VBA PB n° de semaine

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Arpette

XLDnaute Impliqué

ROGER2327

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

youky(BJ)

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Arpette

XLDnaute Impliqué

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée