Calcul automatique des n° de semaine

Commenter

Contenu du snippet

Code permettant de calculer de manière automatique les N° de semaine sur une période donnée.

Explication : 1 - J'ai une semaine qui sert de référence pour le calcul
2 - Depuis cette semaine de référence, je calcul le N° des semaines précédentes et suivantes
3 - Le nombre de semaine a calculer par rapport à la semaine de référence est une donnée paramètrable
4 - Quelque soit l'année, cela fonctionne
5 - Amélioration à venir : position de la semaine de référence va être paramètrable
6 - VBA fonctionnant en adéquation avec Microsoft Excel

Toutes remarques sera la bienvenue

Source / Exemple : 


Public Function Semaine(dat As Date) As Integer
    Dim a As Integer
    a = Int((dat - DateSerial(Year(dat), 1, 1) + _
        ((Weekday(DateSerial(Year(dat), 1, 1)) + 1) _
        Mod 7) - 3) / 7) + 1
    If a = 0 Then
        a = Semaine(DateSerial(Year(dat) - 1, 12, 31))
    ElseIf a = 53 And (Weekday(DateSerial(Year(dat), 12, 31)) - 1) _
        Mod 7 <= 3 Then
        a = 1
    End If
    Semaine = a
End Function

Function WriteWeekAnnee()

Dim NomDuJour(7) As String
Dim StockVal()

LiRef = 3 'La ligne de référence où vont être inscrits la valeur des différentes semaines
Col_Sem_Ref = 6 'Par exemple la semaine de référence se trouve à la colonne N° 6
NB_Colonne_A_Traiter = 34 'Le N° de la dernière colonne à remplir est 30
Lib_Deb_Sem = 4 'N° de la colonne ou commence l'écriture des différentes semaines
Nb_Sem_Before = Col_Sem_Ref - Lib_Deb_Sem 'Nb de semaines avant la semaine de référence

DateActuel = Now
Num_Jour_Actuel = Day(Range("A3").Value) 
Num_Mois_Actuel = Month(Range("A3").Value)
Num_Year_Actuel = Year(Range("A3").Value)
Num_Jour_Sem_Actuel = Weekday(Range("A3").Value, vbUseSystem)

Sem_Ref = Val(Semaine(Range("A3").Value))

If Len(Sem_Ref) = 1 Then
   Range("B2").Value = "0" & Sem_Ref
Else
   Range("B2").Value = Sem_Ref
End If

NbTotSem = 52

LiDeb = Col_Sem_Ref - Nb_Sem_Before

Range(Cells(LiRef, LiDeb), Cells(LiRef, NB_Colonne_A_Traiter)).ClearContents 'On efface les anciennes valeurs

If Sem_Ref Is >= 52 Then
   Sem_Ref = 1
   Num_Year_Actuel = Num_Year_Actuel + 1
Else
   Sem_Ref = Sem_Ref + 1
   Num_Year_Actuel = Num_Year_Actuel
End Select

If Sem_Ref < 10 Then
   Cells(LiRef, Col_Sem_Ref).Value = "0" & Sem_Ref & "/" & Num_Year_Actuel
Else
   Cells(LiRef, Col_Sem_Ref).Value = Sem_Ref & "/" & Num_Year_Actuel
End If

Sem_Actuel = Semaine(CDate(Range("A3").Value))
Sem_Ref = Val(Left(Range("F3").Value, 2))
Annee_Actuel = Val(Year(Range("A3").Value))
Annee_Ref = Val(Right(Cells(LiRef, Col_Sem_Ref).Value, 4))

If Sem_Ref = 1 Then
   Select Case Annee_Ref
   Case Is <> Annee_Actuel
        Range("F3").Offset(0, -1).Value = NbTotSem & "/" & Annee_Ref - 1
        Range("F3").Offset(0, -2).Value = NbTotSem - 1 & "/" & Annee_Ref - 1
   Case Is = Num_Year_Actuel
        Range("F3").Offset(0, -1).Value = NbTotSem & "/" & Annee_Actuel - 1
        Range("F3").Offset(0, -2).Value = NbTotSem - 1 & "/" & Annee_Actuel - 1
   End Select
Else
   If Sem_Ref = 2 Then
      Range("F3").Offset(0, -1).Value = "0" & Sem_Ref - 1 & "/" & Annee_Actuel
      Range("F3").Offset(0, -2).Value = NbTotSem & "/" & Annee_Actuel - 1
   Else
      If Sem_Ref >= 3 And Sem_Ref < 12 Then
         Select Case Sem_Ref
                Case Is <= 10
                     Range("F3").Offset(0, -1).Value = "0" & Sem_Ref - 1 & "/" & Num_Year_Actuel
                     Range("F3").Offset(0, -2).Value = "0" & Sem_Ref - 2 & "/" & Num_Year_Actuel
                Case 11
                     Range("F3").Offset(0, -1).Value = Sem_Ref - 1 & "/" & Num_Year_Actuel
                     Range("F3").Offset(0, -2).Value = "0" & Sem_Ref - 2 & "/" & Num_Year_Actuel
         End Select
      Else
         Range("F3").Offset(0, -1).Value = Sem_Ref - 1 & "/" & Num_Year_Actuel
         Range("F3").Offset(0, -2).Value = Sem_Ref - 2 & "/" & Num_Year_Actuel
      End If
   End If
End If
   
NBIteration = NbTotSem - Left((Cells(LiRef, Col_Sem_Ref).Value), 2)
  
If NBIteration > NB_Colonne_A_Traiter - Col_Sem_Ref Then '24
   NBIteration = NB_Colonne_A_Traiter - Col_Sem_Ref
Else
  If NBIteration = 0 Then
     NBIteration = NB_Colonne_A_Traiter - Col_Sem_Ref
     Sem_Actuel = 0
  Else
     NBIteration = NBIteration
  End If
End If

ReDim StockVal(NBIteration) 'On réalloue de manière dynamique le nbre d'éléments à stocker
  
Val_Sem_Ref = Val(Left((Cells(LiRef, Col_Sem_Ref).Value), 2))
  
If Val_Sem_Ref = NbTotSem Then
   Num_Year_Actuel = Num_Year_Actuel + 1
Else
   Num_Year_Actuel = Num_Year_Actuel
End If

For I = 1 To NBIteration
    Sem_Ref = Sem_Ref + 1
    If Len(Sem_Ref) > 1 Then
       Range("F3").Offset(0, I).Value = Sem_Ref & "/" & Num_Year_Actuel
    Else
       Range("F3").Offset(0, I).Value = "0" & Sem_Ref & "/" & Num_Year_Actuel
    End If
    StockVal(1) = Range("F3").Offset(0, I).Value
Next I
  
Val_Find = StockVal(1)
ValCelSem = Cells.Find(Val_Find, , , , xlByColumns, xlPrevious).Column
AdCelSem = Cells.Find(Val_Find, , , , xlByColumns, xlPrevious).Address
NewYear = Right(Range(adCelSem), 4) + 1
NBIteration = NB_Colonne_A_Traiter - ValCelSem
   
For I = 1 To NBIteration
    If Len(I) = 1 Then
       Sem_Actuel = I
       Range(adCelSem).Offset(0, I).Value = "0" & Sem_Actuel & "/" & NewYear
    Else
       Sem_Actuel = I
       Range(adCelSem).Offset(0, I).Value = Sem_Actuel & "/" & NewYear
    End If
Next I
 
End Function

A voir également

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 (fpetit25)