Numéro ISO des semaines

Le calcul du numéro ISO des semaines (ISO8601:2000) via les fonctions DatePart et Format de Microsoft Access n’est pas exact d’où la nécessité de créer une fonction spécifique.

L’algorithme de base est détaillé ici et Microsoft a proposé une fonction attribué à Daniel Maher pour corriger le bug.

La fonction de Daniel maher est présentée comme étant très efficiente et après quelques recherches sur le web j’ai trouvé une autre fonction qui me semblait optimisable…

La fonction attribuée a daniel Maher qui nous servira de référence :

Public Function IsoWeekNumberDM(d1 As Date) As Long
' Attributed to Daniel Maher
  Dim d2 As Long
   d2 = DateSerial(Year(d1 - Weekday(d1 - 1) + 4), 1, 3)
   IsoWeekNumberDM = Int((d1 - d2 + Weekday(d2) + 5) / 7)
End Function

La fonction que j’ai ‘améliorée':

'Dérivée de la formule trouvée par h1h d'un auteur inconnu...
Public Function IsoWeekNumber(ByVal d As Date) As Long
   Dim wd As Long
   wd = Weekday(d, vbMonday)
   IsoWeekNumber = Int((d - DateSerial(Year(d - wd + 4), 1, 1) - wd + 11) / 7)
End Function

Cet algo peut être codé directement dans une requête SQL (performance non testée).

Il nous faut vérifier sa performance : qualité et rapidité

Qualité
Le code suivant va vérifier que la nouvelle fonction donne le bon numéro de semaine de l’an 101 à 9999 !
Compter une dizaine de secondes pour le test…

Public Function IsoWeekValidation()
   Dim i As Long, j As Long, k As Long
   Dim d As Date
   Dim countErr As Integer
 
   For i = 1 To 9898
      For j = 1 To 12
         For k = 1 To 31
            d = DateSerial(100 + i, j, k)
            If IsoWeekNumber(d) <> IsoWeekNumberDM(d) Then
               Debug.Print "Erreur pour la date du " & d; " - N° Iso trouvé : " & IsoWeekNumber(d) & " pour l'Iso week n°" & IsoWeekNumberDM(d)
               countErr = countErr + 1
               If countErr = 10 Then GoTo fin
            End If
         Next k
      Next j
   Next i
fin:
   Debug.Print "fin"
End Function

Je n’ai constaté aucune erreur dans cette période.

Rapidité
Cette fonction permet de mesurer la performance de chaque fonction (commenter la fonction non testée)

Public Function IsoWeekSpeed()
   Const cNbBoucle As Long = 1
   Dim i As Long, j As Long, k As Long, l As Long, w As Long
   Dim d As Date
   Dim t0 As Single
 
   t0 = Timer
   For l = 1 To cNbBoucle
      For i = 0 To 9898
         For j = 1 To 12
            For k = 1 To 31
               d = DateSerial(101 + i, j, k)
               w = IsoWeekNumber(d)   'nouvelle fonction
              'w = IsoWeekNumberDM(d) 'Référence - Daniel Maher
           Next k
         Next j
      Next i
   Next l
   t0 = Timer - t0
fin:
   Debug.Print "fin", t0, d
End Function

Avec mon ordi, j’obtiens 3.2 secondes et 4.5 secondes pour la référence soit un gain de performance de 30%

Un dernier conseil
Ne pas modifier la nouvelle fonction sans vérifier sa qualité et sa performance car l’ordre des paramètres de la ligne de calcul peut jouer sur l’un et/ou l’autre…

@+

Philippe

Laisser un commentaire