Date du jour de semaine précédent

Publié le par

Episode III de la saga ‘Weekday’. On souhaite obtenir cette fois-ci, la date d’un jour de semaine qui précède la date de référence.

Préambule
Je vous conseille de lire le premier billet de ‘Weekday’ pour comprendre le principe des calculs.
Voir aussi le récapitulatif des fonctions.

Les matrices
On souhaite donc passer de la matrice ‘Weekday’ à la matrice ‘Jour précédent’

Weekday(Date,VbDayOfWeek)                  Jour précédent                      
                   VbDayOfWeek                                VbDayOfWeek      
Jour Date   L   M   M   J   V   S   D      Jour date   L   M   M   J   V   S   D
Lundi       1   7   6   5   4   3   2      Lundi      -7  -6  -5  -4  -3  -2  -1
Mardi       2   1   7   6   5   4   3      Mardi      -1  -7  -6  -5  -4  -3  -2
Mercredi    3   2   1   7   6   5   4 vers Mercredi   -2  -1  -7  -6  -5  -4  -3
Jeudi       4   3   2   1   7   6   5      Jeudi      -3  -2  -1  -7  -6  -5  -4
Vendredi    5   4   3   2   1   7   6      Vendredi   -4  -3  -2  -1  -7  -6  -5
Samedi      6   5   4   3   2   1   7      Samedi     -5  -4  -3  -2  -1  -7  -6
Dimanche    7   6   5   4   3   2   1      Dimanche   -6  -5  -4  -3  -2  -1  -7

 
On remarque que les lignes de la matrice ‘Jour précédent’ correspondent aux lignes de la matrice ‘Weekday’ avec un décalage de 1 jour.
Par exemple, la ligne du lundi de ‘Jour précédent’ est identique en valeur absolue à celle du dimanche de ‘Weekday’, celle du mardi est liée à lundi, etc…

La solution
Il faut donc retrancher un jour à la date de référence avant de la passer à la fonction Weekday() : Weekday(DateRef - 1, Jour)
 
La fonction VBA

Public Function DateJourPrecedent(ByVal DateRef As Date, ByVal Jour As VbDayOfWeek) As Date
   DateJourPrecedent = DateRef - Weekday(DateRef - 1, Jour)
End Function

 
Tester la fonction
La fonction suivante teste les 49 possibilités de la matrice et affiche les résultats dans la fenêtre ‘Exécution’ de l’éditeur VB.

Public Function TestDateJourPrecedent()
   Dim d As Date, r As Date, dates(1 To 7) As Date
   Dim i As Integer, j As Integer, k As Integer, NbErr As Integer
   Dim s As String, Jours As Variant

   d = Int(Now())
   While Weekday(d) <> vbMonday: d = d + 1: Wend
   Jours = VBA.Array("Dimanche", "Lundi   ", "Mardi   ", "Mercredi", "Jeudi   ", "Vendredi", "Samedi  ")

   Debug.Print "Test DateJourPrecedent()" & vbCrLf & "----------------------"
   For i = 1 To 7
      s = vbNullString
      Debug.Print "* Date de référence : " & Format(d, "dddd dd/mm/yyyy")
      Debug.Print vbTab & "Jour cherché" & vbTab & vbTab & "Jour trouvé" & vbTab & vbTab & "Conforme ?" & vbCrLf & _
                  vbTab & "----------------------------------------------"
      For k = 1 To 7: dates(Weekday(d - k)) = d - k: Next k

      For j = 1 To 7
         r = DateJourPrecedent(d, j)
         s = s & vbTab & Jours(j - 1) & vbTab & vbTab & Format(r, "ddd dd/mm/yyyy") & vbTab & vbTab
         If r <> dates(j) Then
            NbErr = NbErr + 1
            s = s & "Erreur !" & vbCrLf
         Else
            s = s & "Ok" & vbCrLf
         End If
      Next j
      Debug.Print s
      d = d + 1
   Next i
   Debug.Print "***" & IIf(NbErr > 0, NbErr, " Aucune") & " erreur(s) commise(s) ***"
End Function

 
@+ pour la suite des épisodes ‘Weekday’.

Philippe

Laisser un commentaire