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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 39 043 fois - Téléchargée 39 fois

Commenter

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

Signaler
KaFarD
Messages postés
38
Date d'inscription
mercredi 12 mars 2003
Statut
Membre
Dernière intervention
29 mai 2008
 -
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+++
Signaler
Le Docteur
Messages postés
5
Date d'inscription
vendredi 30 mars 2007
Statut
Membre
Dernière intervention
4 décembre 2007
 -
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)
Signaler
grarestephane
Messages postés
34
Date d'inscription
mercredi 12 décembre 2007
Statut
Membre
Dernière intervention
6 décembre 2009
 -
Pas grave ajoute 1, le tour est joué
Signaler
Le Docteur
Messages postés
5
Date d'inscription
vendredi 30 mars 2007
Statut
Membre
Dernière intervention
4 décembre 2007
 -
"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 !
Signaler
grarestephane
Messages postés
34
Date d'inscription
mercredi 12 décembre 2007
Statut
Membre
Dernière intervention
6 décembre 2009
 -
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é !
Afficher les 23 commentaires
S'inscrire maintenant

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.

Du même auteur (ShareVB)