Date du jour-même ou suivant

Publié le par

Episode II de la saga ‘Weekday’. On souhaite obtenir cette fois-ci, soit la date de référence si elle correspond au jour de semaine recherché soit la date suivante. La date retournée est donc ici supérieure ou égale à la date de référence contrairement au premier billet de ‘Weekday’ où la date retournée était strictement supérieure à la date de référence.

Préambule
Je vous conseille de lire le premier billet ‘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 courant ou suivant’

Weekday(Date,VbDayOfWeek)                    Jour courant ou suivant                    
                   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       0   1   2   3   4   5   6
Mardi       2   1   7   6   5   4   3       Mardi       6   0   1   2   3   4   5
Mercredi    3   2   1   7   6   5   4  vers Mercredi    5   6   0   1   2   3   4
Jeudi       4   3   2   1   7   6   5       Jeudi       4   5   6   0   1   2   3
Vendredi    5   4   3   2   1   7   6       Vendredi    3   4   5   6   0   1   2
Samedi      6   5   4   3   2   1   7       Samedi      2   3   4   5   6   0   1
Dimanche    7   6   5   4   3   2   1       Dimanche    1   2   3   4   5   6   0

 
On remarque que toutes les valeurs de la diagonale de la matrice finale sont égales à zéro alors qu’elles étaient égales à 7 dans le premier billet. La matrice pivot reste donc la même sauf que le résultat de cette diagonale est égal à 7 (8 – 1) au lieu de zéro…
Il faut donc réaliser une opération supplémentaire qui transformera la valeur 7 en zéro.

La solution
Il existe plusieurs solutions mais j’ai choisi d’utiliser l’opérateur modulo (MOD). Cet opérateur retourne le reste de la division de deux nombres. Exemples : 5 MOD 4 = 1 et 3 MOD 4 = 3.
Dans notre cas, (8 – 1) MOD 7 = 0 ce qui correspond bien à la valeur attendue dans la diagonale sans modifier les autres valeurs puisqu’elles sont toutes inférieures à 7.

La fonction VBA

Public Function DateJourMemeOuSuivant(ByVal DateRef As Date, ByVal Jour As VbDayOfWeek) As Date
   DateJourMemeOuSuivant = DateRef + ((8 - CInt(Weekday(DateRef, Jour))) Mod 7)
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 TestDateJourMemeOuSuivant()
   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 DateJourMemeOuSuivant()" & 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 6: dates(Weekday(d + k)) = d + k: Next k
      dates(Weekday(d)) = d

      For j = 1 To 7
         r = DateJourMemeOuSuivant(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