code vba pour n° de semaine à partir d'une colonne de date

Version imprimable

01/11/2017, 15h57
rolando06

code vba pour n° de semaine à partir d'une colonne de date
Bonjour à toutes et à tous

J'utilise la fonction suivante pour avoir les numéros de semaine que j'applique sur une colonne qui comprend plus de 5000 dates
Code:

1 2 3 Function NoSemaineISO(d As Date) As Integer NoSemaineISO = Format(d, "ww", vbMonday, vbFirstFourDays) End Function
et
Code:

1 2 3 4 5 6 7 Sub semISO() Dim lig As Long For lig = 2 To [A65536].End(xlUp).Row Cells(lig, 13) = NoSemaineISO(Cells(lig, 1)) Next lig End Sub
Cette macro fonctionne très bien mais le temps de traitement est trop important,
j'ai donc pensé à utiliser les tableaux qui peuvent je pense améliorer la vitesse mais mes connaissances en vba sont limitées

Merci infiniment pour votre aide
01/11/2017, 16h04
Philippe Tulliez

Bonjour,
Il existe une fonction native d'excel qui calcule le numéro de la semaine.
Si tu souhaites par VBA, insérer une formule il est inutile de passer par une boucle. A lire ce billet Ecrire une formule dans Excel à l'aide d'une procédure VBA

Salut, sans certitudes, à tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
 
Private Function NoSemaineISO(d As Date) As Integer
    NoSemaineISO = Format(d, "ww", vbMonday, vbFirstFourDays)
End Function
 
Sub semISO()
Dim lig As Long
Dim LastRow As Long
Dim Dep As Currency, Fin As Currency, Freq As Currency
 
    QueryPerformanceCounter Dep
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.EnableEvents = False
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    For lig = 2 To LastRow
        Feuil1.Cells(lig, 13) = NoSemaineISO(Feuil1.Cells(lig, 1))
    Next lig
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
 
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox Format(((Fin - Dep) / Freq), "0.000 s")
End Sub

01/11/2017, 16h44
rolando06

Bonjour et merci

J'ai testé votre macro qui fonctionne bien, avec 7,6s pour appliquer cette fonction, c'est sensiblement le temps de ma boucle initiale !?
01/11/2017, 17h02
rolando06

en appliquant la formule en vba

Code:

.Offset(0, 13).FormulaR1C1 = "=INT(MOD(INT((R[2]C[-10]-2)/7)+0.6,52+5/28))+1"

0,027s

Un grand merci à vous deux

Bonjour,
Comme je l'ai écrit, pas besoin de boucle pour écrire une formule et c'est nettement plus rapide.
Placement de la formule en colonne B
Code:

1 2 3 4 LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row With Feuil1 .Range("B2:B" & LastRow).Formula = "=INT(MOD(INT((A2-2)/7)+0.6,52+5/28))+1" End With
et avec la fonction native d'excel
Code:

1 2 3 With Feuil1 .Range("B2:B" & LastRow).Formula = "=WEEKNUM(A2,21)" End With

01/11/2017, 20h34
rolando06

Merci infiniment à vous deux