Retrouver le numero de la semaine d'une date donnée

0/5 (23 avis)

Snippet vu 40 338 fois - Téléchargée 41 fois

Contenu du snippet

->NumeroSemaine est la function qui renvoie le numero de la semaine d'une date donnée
a part ca :
JJ fonction renvoie la date julienne a partir d'une date donnée
JourSemaine renvoie le jour de la semaine pour une date donnée (0 = Dimanche,1 = Lundi...)
JourAnnée renvoie le numero du jour donnée dans l'année (1 = 01/01)

Source / Exemple :


Option Explicit

Private Function JJ(Dates As Date)
Dim y As Long, m As Long, DDdd As Double
Dim YYYY As Long, MM As Long
Dim a As Double, b As Double

YYYY = Year(Dates)
MM = Month(Dates)
DDdd = Day(Dates) + Hour(Dates) / 24 + Minute(Dates) / 24 / 60 + Second(Dates) / 24 / 60 / 60

If MM <= 2 Then y = YYYY - 1: m = MM + 12 Else y = YYYY: m = MM
If Dates >= 1582.1015 Then
a = y \ 100
b = 2 - a + a \ 4
End If

If y = Abs(y) Then
JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5 + b
Else
JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5
End If
End Function

Private Function JourSemaine(Dat As Date) As Long
Dim a As Double
a = JJ(Dat) + 1.5
a = a Mod 7
JourSemaine = a
End Function

Private Function JourAnnée(Dat As Date) As Integer
Dim I As Integer
I = Year(Dat)
If (I Mod 400 = 0) Or ((I Mod 100 <> 0) And (I Mod 4 = 0)) Then
JourAnnée = Int((275 * Month(Dat)) / 9) - Int((Month(Dat) + 9) / 12) + Day(Dat) - 30
Else
JourAnnée = Int((275 * Month(Dat)) / 9) - (2 * Int((Month(Dat) + 9) / 12)) + Day(Dat) - 30
End If
End Function

Public Function NumeroSemaine(Dates As Date) As Byte
Dim NbJour1ereSemaine As Byte, JourJulienDates As Double, JourJulien1Janvier
Dim JourSemaine1Janvier As Byte, JourAnneeDates As Integer

JourJulienDates = JJ(Dates)
JourJulien1Janvier = JJ(DateSerial(Year(Dates), 1, 1))
JourSemaine1Janvier = JourSemaine(DateSerial(Year(Dates), 1, 1) + TimeSerial(0, 0, 0))

If JourSemaine1Janvier = 0 Then
NbJour1ereSemaine = 1
Else
NbJour1ereSemaine = -(JourSemaine1Janvier - 8)
End If

NumeroSemaine = Int((JourAnnée(Dates) - 1 - NbJour1ereSemaine) / 7) + 2
If NumeroSemaine > 52 Then NumeroSemaine = NumeroSemaine - 52
End Function

Conclusion :


alors on met ca dans un module, on appelle NumeroSemaine ou on veut dans le code
et pis si on sait pas faire un copier-coller ben faut arreter l'informatique ;)) lol

A voir également

Ajouter un commentaire Commentaires
KaFarD Messages postés 38 Date d'inscription mercredi 12 mars 2003 Statut Membre Dernière intervention 29 mai 2008
15 mai 2009 à 13:54
Solution LIGHT: ( une fonction )

Function WOY (MyDate As Date) As Integer ' Week Of Year
WOY = Format(MyDate, "ww", vbMonday, vbFirstFourDays)
If WOY > 52 Then If Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) 2 Then WOY 1
End If
End Function

Utilisation:
Mon_numéro_de_semaine = WOY(ma_date)

A+++
Le Docteur Messages postés 5 Date d'inscription vendredi 30 mars 2007 Statut Membre Dernière intervention 4 décembre 2007
13 mai 2009 à 17:57
D'accord, sauf que le bug existe toujours avec les
lundi 29/12/2003 et lundi 31/12/2007 (renvoit semaine 53 au lieu de semaine 1)
grarestephane Messages postés 34 Date d'inscription mercredi 12 décembre 2007 Statut Membre Dernière intervention 6 décembre 2009
12 mai 2009 à 18:04
Pas grave ajoute 1, le tour est joué
Le Docteur Messages postés 5 Date d'inscription vendredi 30 mars 2007 Statut Membre Dernière intervention 4 décembre 2007
11 mai 2009 à 14:45
"msgbox DateDiff("w",DateSerial(Year(Date),1,1),Date)"

C'était séduisant, mais...
1 - l'argument pour la semaine est "ww"
2 - il faut utiliser les arguments "firstdayofweek" et "Firstweekofyear"
ce qui donnerait :
DateDiff("ww",DateSerial(Year(Date),1,1),Date,2,2)

Mais malgré ça je n'obtiens jamais la bonne semaine.

pour aujourd'hui, 11/05/2009, j'obtiens la semaine 19 alors que nous sommes en semaine 20 !
grarestephane Messages postés 34 Date d'inscription mercredi 12 décembre 2007 Statut Membre Dernière intervention 6 décembre 2009
1 mai 2009 à 16:21
Trève de bavarderie, voilà la réponse, une seule ligne, avec mon msgbox la réponse est direct...

msgbox DateDiff("w",DateSerial(Year(Date),1,1),Date)

Merci d'avoir joué !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.