Discussion :

[MichaSarah]

Bonsoir,
Je souhaite pouvoir transformer une date en semaine avec le format Saass. J'ai trouvé le code ci-dessous qui fonctionne mais qui donne des infos éronées pour certaines années . ex : Pour le 01/01/11 il s'affiche S1152 ald S1052. Pouvez-vous m'indiquer le code qui permet de tenir compte des semaines à cheval sur 2 années ou des années à 53 semaines ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Cmd2_Click()
Annee = DatePart("yyyy", TxtDate1)
NumSem = DatePart("ww", TxtDate1, 2, 3)
TxtSemaine = "S" & Right(Annee, 2) & NumSem
End Sub

Merci
MichaSarah

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
NumSem = DatePart("ww", TxtDate1, 2, 3)
Annee = IIf(NumSem >= 52 And Month(TxtDate1) = 1, -1, 0) + Year(TxtDate1)
TxtSemaine = "S" & Right(Annee, 2) &  Format(NumSem, "00")

[JPierreM]

Bonjour,

Concernant DatePart je pense qu’il y a un problème

Si on code pour le 31/12/2007 qui tombe un lundi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

numSem = DatePart("ww", 31/12/2007, vbMonday, vbFirstFourDays)

on obtient 53
pour le 01/01/2008 donc le lendemain

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

numSem = DatePart("ww", 01/01/2008, vbMonday, vbFirstFourDays)

on obtient 1
Deux numéros de semaine pour la même semaine

On n’a pas ce problème avec le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 laDate = Int(laDate)
    numSem1 = DateSerial(Year(laDate + (8 - Weekday(laDate)) Mod 7 - 3), 1, 1)
    numSem1 = ((laDate - numSem1 - 3 + (Weekday(numSem1) + 1) Mod 7)) \ 7 + 1

De là à dire que ça couvre tout, je n’en sais rien

Si on utilise la formule de Laurent Longre (je pense)
=ENT((A39+5-SOMME(MOD(DATE(ANNEE(A39-MOD(A39-2;7)+3);1;2);{1E+99;7})*{1;-1}))/7)
En A39 se trouve la date
On obtient le bon résultat soit 1 dans les deux cas

[MichaSarah]

Bonsoir,
Je viens vous solliciter encore une fois car il ya un phénomène que je ne comprends pas. j'ai commencé à utiliser le code suivant pour avoir le n° de semaine :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Annee = DatePart("yyyy", TxtDate1)
NumSem = DatePart("ww", TxtDate1, 2, 3)
        If (NumSem = 52 Or NumSem = 53) Then
            TxtSemaine = "S" & Right(Annee - 1, 2) & NumSem
 
            Else: TxtSemaine = "S" & Right(Annee, 2) & NumSem
 
        End If

Tout se passe bien jusqu'au 31/12/12, ensuite le n° de semaine est systématiquement décalé de -1.
j'ai du ajouter le code suivant pour prendre le relais à partir du 01/01/13.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    MaDate = TxtDate1.Value
    Numero = Format(MaDate, "yyww", vbMonday)
    Numero1 = Right(Numero, 4)
    Numero2 = "S" & Numero1
    TxtSemaine = Numero2

Celà fonctionne mais ce n'est pas très académique, et surtout je n'arrive pas à l'expliquer. Avez-vous une idée ?
merci
salutations
MichaSarah

[JPierreM]

Bonjour,

Est-il possible d'avoir un fichier joint

[MichaSarah]

Bonjour JPierreM,

J'ai pu trouver une solution en testant sur le jour de la semaine. Si le jour est le 29 ou 30 ou 31 de la semaine 1 alors le numéro de semaine et l'année se callent bien (en tous cas sur les exemples que j'ai pris) Qu'en penses -tu ?

En pièce jointe mon fichier

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
 
Private Sub Cmd2_Click()
On Error GoTo fin
 
        MaDate = TxtDate1.Value
        Dim Valeur As Byte
        Dim NumSem As Byte
        Dim jour As Byte
        Dim Annee As String
 
        Annee = DatePart("yyyy", TxtDate1)
        NumSem = DatePart("ww", TxtDate1, 2, 2)
        jour = DatePart("d", TxtDate1, 2, 2)
 
If TxtDate1 = "" Then Exit Sub
 
If Not IsDate(TxtDate1) Then
        MsgBox "Veuillez saisir une date valide"
        TxtSemaine = ""
        TxtDate1 = ""
        TxtDate2 = ""
        TxtDate3 = ""
        Exit Sub
 
        Else
        If (jour = 29 Or jour = 30 Or jour = 31) And NumSem = 1 Then
            TxtSemaine = "S" & Right(Annee + 1, 2) & NumSem
                Else: TxtSemaine = "S" & Right(Annee, 2) & NumSem
        End If
 
 
 
End If
 
If temp3 < 53 Or (temp3 < 54 And Weekday(DateSerial(temp2 + 1, 1, 3), vbMonday) = 7) Then
                'Nb de caractère dans champs semaine
                temp4 = Len(TxtSemaine)
                'Prendre les 3 caractères de gauche du champs semaine
                temp1 = Left(TxtSemaine, 3)
                'Prendre les 2 caractères de droite pour avoir l'année
                temp2 = Right(temp1, 2)
                'Prendre les caractères de droite pour avoir le n° de semaine
                temp5 = temp4 - 3
                temp3 = Right(TxtSemaine, temp5)
                    TxtDate2 = DateSerial(temp2, 1, 4) - Weekday(DateSerial(temp2, 1, 4), vbMonday) + 1 + (temp3 - 1) * 7
                    TxtDate3 = DateSerial(temp2, 1, 4) - Weekday(DateSerial(temp2, 1, 4), vbMonday) + 7 + (temp3 - 1) * 7
End If
 
fin:
End Sub

Merci
Salutations
MichaSarah

[MichaSarah]

JPierreM,
Ci-joint le document.

MichaSarah

[mercatog]

Je veux bien comprendre ce que cloche dans ces lignes de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Cmd2_Click()
Dim NumSem As Integer, Annee As Integer
MsgBox Format(TxtDate1, "dddd dd mmm yyyy")
NumSem = DatePart("ww", TxtDate1, 2, 3)
Annee = IIf(NumSem >= 52 And Month(TxtDate1) = 1, -1, 0) + Year(TxtDate1)
TxtSemaine = "S" & Right(Annee, 2) & Format(NumSem, "00")
End Sub

[JPierreM]

Bonsoir,

Bien relu le code de MichaSarah

Je reste persuadé que la fonction DatePart n'est pas fiable

Pour illustrer mon propos je cherhe le n° semaine du 31/12/2007 qui tombe un lundi et celui du 01/01/2008. Ils devraient avoir le même n°

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
Sub sc()
 
 
    [B2] = DatePart("ww", 31 / 12 / 2007, vbMonday, vbFirstFourDays)
    [B3] = DatePart("ww", 1 / 1 / 2008, vbMonday, vbFirstFourDays)
 
    [C2] = DatePart("ww", #12/31/2007#, vbMonday, vbFirstFourDays)
    [C3] = DatePart("ww", #1/1/2008#, vbMonday, vbFirstFourDays)
 
    [D2] = DatePart("ww", CDate("31/12/2007"), vbMonday, vbFirstFourDays)
    [D3] = DatePart("ww", CDate("01/01/2008"), vbMonday, vbFirstFourDays)
 
    [E2] = DatePart("ww", DateSerial(2007, 12, 31), vbMonday, vbFirstFourDays)
    [E3] = DatePart("ww", DateSerial(2008, 1, 1), vbMonday, vbFirstFourDays)
 
    [F2] = NOSEM(DateSerial(2007, 12, 31))
    [F3] = NOSEM(DateSerial(2008, 1, 1))
 
End Sub
 
Function NOSEM(D As Date) As Long
   D = Int(D)
   NOSEM = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
   NOSEM = ((D - NOSEM - 3 + (Weekday(NOSEM) + 1) Mod 7)) \ 7 + 1
End Function

Tous les cas renvoyés sont faux sauf celui utilisant la fonction NOSEM

Si toutefois je fais erreur concernant DatePart et que vous avez une explication je suis preneur, sinon pourquoi ne pas utiliser cette fonction ça allégera le code

JP