Numéro de la semaine : sans les bugs de la semaine 53 et du 29/12 (testé et vérifié)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 735 fois - Téléchargée 34 fois

Contenu du snippet

Il y a un ensemble de fonction dont 2 que j'ai eu sur ce site mais je les ai un peu remaniées pour qu'elles soient plus compréhensibles. Mais j'ai entièrement créé la fonction principale nommée : "NumeroSemaine".

S'en servir est très facile, il suffit de mettre la date en argument de la fonction pour avoir le numéro EXACT de la semaine! En effet, la majorité des codes que j'ai trouvé avaient juste un bug ou deux. Celui que je propose n'a pas les bugs de la semaine 53 et du 29 décembre (si vous en trouvez un... prévenez-moi!

Finalement, c'est plus une mise à jour de fonctions déjà existantes que d'une nouvelle fonction!!!

Source / Exemple :


Option Explicit

Public Function NumeroSemaine(dateSemaine As Date) As Integer
'Réalisé par Alexsimps en VBA

Dim Jour As Date
Dim NumJour As Integer
Dim DernierJourSemaine As Date
Dim NbJour As Integer
Dim nbpremier As Integer

    'Correspond au 1 er janvier de l'année de la date donnée
    Jour = DateSerial(Year(dateSemaine), 1, 1)
    
    'Correspond au jour dans la semaine (1 = lundi, 2 = mardi, 3 = mercredi, 4 = jeudi, etc ...)
    NumJour = JourSemaine(Jour)
    
    'Correspond au dernier jour de la semaine du 1er janvier
    DernierJourSemaine = DateSerial(Year(dateSemaine), 1, 8 - NumJour)
    
    'Si le 1er janvier est après le vendredi, la semaine du 1 er janvier n'est pas comptabilisée dans la nouvelle année
    If NumJour > 5 Then
        NumeroSemaine = 0
    Else
    'sinon elle l'est
        NumeroSemaine = 1
    End If
    
    'Différence entre la date et le jour de la fin de semaine du 1er janvier
    NbJour = dateSemaine - DernierJourSemaine

    'Ensuite, on calcule le numéro de la semaine
    'Si le calcul tombe juste, on met le résultat
    If NbJour Mod 7 = 0 Then
        NumeroSemaine = (NbJour / 7) + NumeroSemaine
    Else
    'Sinon, on, rajoute un car il y a une semaine en cours
        NumeroSemaine = NumeroSemaine + Int(NbJour / 7) + 1
    End If
    
    'Si le numéro est égal à 53, on vérifie où se trouve le 1er janvier
    If NumeroSemaine = 53 Then
        nbpremier = JourSemaine(DateSerial(Year(dateSemaine) + 1, 1, 1))
        
        'Si le 1er tombe avant le vendredi, le numéro de la semaine est le numéro 1
        If nbpremier < 5 Then
            NumeroSemaine = 1
        End If
        'sinon, le numéro est le 53
    End If
    
    'Le numéro de la semaine peut être egale à 0 (01/01/2005)
    'car il ne detécte pasla semaine 53
    'On cherche alors le numéro de la semaine du 31/12 de l'année d'avant
    If NumeroSemaine = 0 Then
        'Sauf si le 01/01 est le lundi
        If nbpremier = 1 Then
            NumeroSemaine = 1
        Else
            NumeroSemaine = NumeroSemaine(DateSerial(Year(dateSemaine) - 1, 12, 31))
        End If
    End If
End Function

Private Function NumeroJourJulien(dateATraiter As Date)
'Récupéré sur vbFrance.com
'J'ai uniquement renommé quelques variables
'Par Alexsimps
Dim y As Long
Dim m As Long
Dim DDdd As Double
Dim Annee As Long
Dim Mois As Long
Dim a As Double
Dim b As Double

Annee = Year(dateATraiter)
Mois = Month(dateATraiter)
DDdd = Day(dateATraiter) + Hour(dateATraiter) / 24 + Minute(dateATraiter) / 24 / 60 + Second(dateATraiter) / 24 / 60 / 60

If Mois <= 2 Then y = Annee - 1: m = Mois + 12 Else y = Annee: m = Mois

If dateATraiter >= 1582.1015 Then
  a = y \ 100
  b = 2 - a + a \ 4
End If

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

End Function

Private Function JourSemaine(LaDate As Date) As Integer
'Récupéré sur vbfrance.com
'Quelques modifications quand même...
'Par Alexsimps
Dim res As Double

res = NumeroJourJulien(LaDate) + 1.5
res = res Mod 7
JourSemaine = CInt(res)

End Function

Conclusion :


Merci pour le gens de VBFrance (je me souviens plus son nom) qui m'a filé... euh, sur lequel j'ai "pompé" deux fonctions, s'il se reconnait, ben je lui dis merci!

A voir également

Ajouter un commentaire

Commentaires

Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
61
sub
function
...
end function
end sub

ca peut pas etre imbriqué...
jodeciters
Messages postés
7
Date d'inscription
vendredi 26 décembre 2008
Statut
Membre
Dernière intervention
16 mars 2009

Bonjour
je cherche également à obtenir un numéro de semaine dans une suite de dates en colonne.
Je programme ci-dessous que j'ai trouvé à plusieurs reprises dans des forums semble est correct.

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

Mon souci est que je ne sais pas le mettre en oeuvre. Lorsque je tâche de l'exécuter, j'ai un message d'erreur du type "end sub attendu"

voici le code que j'ai tenté de faire :
Sub sen()

Function num_sem(D As Date) As Long

D = Range("A2").Value 'pour exemple A2 indique une date

num_sem = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
num_sem = ((D - num_sem - 3 + (Weekday(num_sem) + 1) Mod 7)) \ 7 + 1
End Function

End Sub

merci de votre aide
cs_orwen
Messages postés
1
Date d'inscription
vendredi 13 janvier 2006
Statut
Membre
Dernière intervention
8 octobre 2008

Merci pour le code Renfield, très utile et testé avec succès.
Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
61
EBartSoft, et moi même avons également déposé des Snippets qui pourraient t'être utile
Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
61
ok, ok,

Gobillot semble avoir prévu ce soucis :
http://www.codyx.org/snippet_recuperer-numero-semaine_61.aspx#401

testé avec mon code, issu du descriptif fournis sur le site wikipedia
http://fr.wikipedia.org/wiki/ISO_8601#Num.C3.A9ro_de_semaine

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.