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
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.