Recherche de la dernière semaine d'un mois (selon position du mercredi) [Résolu]

[thomas.m]

Bonjour,

Après de nombreuses recherches, je n'ai pas trouvé de solution à mon problème.
Je dois traiter des dates (en fait des strings au format "YYYY/MM" et "YYYY/WW" uniquement) dans mes requêtes, tables et formulaires. Tout particulièrement, j'ai souvent besoin de la première semaine d'un mois, et de la dernière semaine. Il s'agit là de semaines industrielles dépendant de la position du mercredi.

Par exemple, si le mercredi est en Mai, alors cette semaine "appartient" au mois de Mai.

J'ai donc créé quelques fonctions:

Code :

1
2
3
4
5
6
7
8
9
10
11
Public Const FIRSTDAYOFWEEK = vbWednesday
Public Const FIRSTWEEK = vbFirstFourDays
 
Function PremiereSemaineMois(ByVal Donnée As String) As String 'Donnée au format "YYYY/MM"
    PremiereSemaineMois = Format(Format(Donnée, "yyyy/mm"), "yyyy/ww", FIRSTDAYOFWEEK, FIRSTWEEK)
End Function
 
Function DerniereSemaineMois(ByVal Donnée As String) As String 'Donnée au format "YYYY/MM"
    'Je rajoute un mois et j'enlève une semaine:
    DerniereSemaineMois = Format(DateAdd("ww", -1, Format(Format(MoisSuivant(Donnée), "yyyy/mm", FIRSTDAYOFWEEK, FIRSTWEEK), "dd/mm/yyyy", FIRSTDAYOFWEEK, FIRSTWEEK)), "yyyy/ww", FIRSTDAYOFWEEK, FIRSTWEEK)
End Function

Cela marche la plupart du temps, mais lorsque le mois commence par un mercredi justement, cela ne fonctionne pas. Exemple: Mois de Mars, la fonction renvoie 2011/22 au lieu de 2011/21.
J'ai essayé toutes les combinaisons possibles avec vbFirstFullWeek, vbFirstJan1 ...

Merci d'avance pour votre aide

[thomas.m]

Je viens de trouver une réponse bricolée qui fonctionne, si ça peu en intéresser certains:

Code :

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
Public Const FIRSTDAYOFWEEK = vbWednesday
Public Const FIRSTWEEK = vbFirstFullWeek
 
Function PremiereSemaineMois(ByVal Donnée As String) As String
    'PremiereSemaineMois = Format(Format(Donnée, "yyyy/mm"), "yyyy/ww", FIRSTDAYOFWEEK, FIRSTWEEK)
    Dim i As Integer
    Dim semaine As String
    i = 1
    While i <= 7
        If (DatePart("w", DateSerial(DatePart("YYYY", Format(Donnée, "YYYY/MM")), DatePart("m", Format(Donnée, "YYYY/MM")), i), FIRSTDAYOFWEEK) = 1) Then
            semaine = DateSerial(DatePart("YYYY", Format(Donnée, "YYYY/MM")), DatePart("m", Format(Donnée, "YYYY/MM")), i)
        End If
        i = i + 1
    Wend
    PremiereSemaineMois = Format(semaine, "YYYY/WW", FIRSTDAYOFWEEK, FIRSTWEEK)
End Function
 
Function DerniereSemaineMois(ByVal Donnée As String) As String
        Donnée = MoisSuivant(Donnée)
    Dim i As Integer
    Dim semaine As String
    i = 1
    While i <= 7
        If (DatePart("w", DateSerial(DatePart("YYYY", Format(Donnée, "YYYY/MM")), DatePart("m", Format(Donnée, "YYYY/MM")), i), FIRSTDAYOFWEEK) = 1) Then
            semaine = DateSerial(DatePart("YYYY", Format(Donnée, "YYYY/MM")), DatePart("m", Format(Donnée, "YYYY/MM")), i)
        End If
        i = i + 1
    Wend
    DerniereSemaineMois = Format(DateAdd("d", -7, semaine), "YYYY/WW", FIRSTDAYOFWEEK, FIRSTWEEK)
End Function

Si il existe plus simple je suis preneur bien sur.

[tedo01]

Bonjour,
Il me manque une info à la description du problème : comment sont numérotées les semaines dans l'année ?

[thomas.m]

Elles sont numérotées comme dans un calendrier classique en fait : S01, S02 etc ... (sont stockées au format YYYY/WW).
Il me faut juste une notion de semaine appartenant à un mois. On considère donc qu'une semaine SXX appartient à un Mois Y si son mercredi est dans le mois Y.
Donc par exemple en Mars 2011 j'ai les semaines 9, 10, 11, 12 et 13.
En Avril : 14, 15, 16 et 17. etc.

Voir la numérotation des semaines:
http://www.mathieuweb.fr/calendrier/...e=0&logement=1

EDIT: La semaine n°1 commence à la première semaine de 4 jours, comme sur la plupart des calendriers, MAIS mes deux fonctions ci dessus ne fonctionnent correctement que si je met l'attribut vbFirstFullWeek ... Etrange non?

[tedo01]

Re-bonjour,

Voilà un code que j'ai essayé de tester sur la page de calendrier... il y a des cas assez tordus !

Attention, les paramètres FirstDayOfWeek et Firstweekofyear pour la fonction Format s'appliquent au calendrier pour déterminer la numérotation des semaines. Il faut dont les alimenter avec vbMonday et vbFirstFourDays, et tester le cas des mercredi dans le code.

J'espère que je n'ai pas oublié de cas

Code :

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
51
Function PremiereSemaineMois(ByVal strDonnee As String) As String
Dim intSemaine As Integer
Dim intMois As Integer
Dim intAnnee As Integer
 
    intAnnee = CInt(Mid(strDonnee, 1, 4))
    intMois = CInt(Mid(strDonnee, 6, 2))
 
    'Numéro de la semaine du premier jour du mois
    intSemaine = Format(DateSerial(intAnnee, intMois, 1), "ww", vbMonday, vbFirstFourDays)
 
    'Si le premier est après le mercredi, la première semaine du mois est la suivante
    If Weekday(DateSerial(intAnnee, intMois, 1), vbMonday) > 3 Then
        intSemaine = intSemaine + 1
        'Changement d'année, quand le 1er janvier tombe dans la dernière semaine de l'année précédente
        If intSemaine >= 53 Then
            intSemaine = 1
        End If
    End If
 
    PremiereSemaineMois = intAnnee & "/" & intSemaine
 
End Function
 
Function DerniereSemaineMois(ByVal strDonnee As String) As String
Dim intSemaine As Integer
Dim intMois As Integer
Dim intAnnee As Integer
 
    intAnnee = CInt(Mid(strDonnee, 1, 4))
    intMois = CInt(Mid(strDonnee, 6, 2))
 
    'Numéro de la semaine du dernier jour du mois
    intSemaine = Format(DateSerial(intAnnee, intMois + 1, 0), "ww", vbMonday, vbFirstFourDays)
 
    'Si le dernier jour du mois est après le mercredi, la dernière semaine du mois est la précédente
    If Weekday(DateSerial(intAnnee, intMois + 1, 0), vbMonday) < 3 Then
        intSemaine = intSemaine - 1
        'Changement d'année, quand le 31 décembre est dans la première semaine de l'année suivante
        If intSemaine = 0 Then
            intSemaine = 52
        End If
    End If
    'Si la semaine est sur l'année suivante
    If intMois = 12 And intSemaine = 1 Then
        intAnnee = intAnnee + 1
    End If
 
    DerniereSemaineMois = intAnnee & "/" & intSemaine
 
End Function

[helas]

Bonjour,
Cela est efficace
à partir d'une date, retourne la premiere ou la derniere semaine

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Function PremiereSemaine(d As Date)
 d = "01/" & Month(d) & "/" & Year(d)
 Do Until Format$(d, "dddd") = "Mercredi"  'premier mercredi du mois
  d = d + 1
 Loop
 PremiereSemaine = Format$(d, "yyyyww", 2, 2)
End Function
 
Function DerniereSemaine(d As Date)
 d = "01/" & Month(d) + 1 & "/" & Year(d)
 d = d - 1
 Do Until Format$(d, "dddd") = "Mercredi"  'dernier mercredi du mois
  d = d - 1
 Loop
 DerniereSemaine = Format$(d, "yyyyww", 2, 2)
End Function

[thomas.m]

Envoyé par tedo01

Attention, les paramètres FirstDayOfWeek et Firstweekofyear pour la fonction Format s'appliquent au calendrier pour déterminer la numérotation des semaines. Il faut dont les alimenter avec vbMonday et vbFirstFourDays, et tester le cas des mercredi dans le code

Effectivement tu as raison il faut bien que je laisse VbMonday et non VbWednesday car sinon j'ai une première semaine de l'année qui est fausse.

Merci à toi Tedo et à Helas pour vos réponses. J'aime bien la solution d'Hélas, clair net et efficace.

[tedo01]

Bonjour,

Attention helas, ces fonctions ne marchent pas dans tous les cas.

1. La fonction DerniereSemaine ne renvoit pas la bonne valeur pour le mois de décembre. Par exemple, pour le 31.12.2010, le résultat devrait être 2010/52 et pas 2010/1.

1.

Code :

Format$(d, "dddd") = "Mercredi"

ne marche pas toujours, cela dépend de la langue.
Même en français, sur mon poste, c'est le libellé "mercredi" qu'il faut tester sinon ça part dans une boucle sans fin.
Il est plus propre d'utiliser

Code :

WeekDay(d,vbMonday)

et tester la valeur 3 pour mercredi.

3.

Code :

Format$(d, "yyyyww", 2, 2)

n'est pas très lisible, autant utiliser les constantes fournies et écrire

Code :

Format$(d, "yyyyww", vbMonday, vbFirstFourDays)

[thomas.m]

Je prends note, merci.