Extraction en fonction d'une période de date

Le 25/08/2023 à 23:01

Bonjour le forum,

J'ai une macro (bouton "visualisation des bons de visite du jour" dans l'onglet "Récapitulatif) qui fonctionne très bien pour m'extraire les bons de visite du jour mais je ne sais pas comment la modifier pour qu'elle m'extrait également les bons de visite qui correspondent au jour présent lorsque que la date de début et de fin correspond à une période de plus d'un jour.

Je m'explique par exemple pour essayer d'être plus clair. Dans le fichier joint à la date si on est à la date du 26 août ma macro devrait me dire que le bon n°1 et n°2 sont prévus pour ce jour. Pour le bon n°1 pas de soucis mais pour le bon n°2 comme la date du début est le 24/08/2023 et que pour l'exemple nous somme le 26/08 il ne sort pas avec ma macro ci-dessous malgré qu'il est bien prévu pour le 26/08 car il va du 24/08 au 01/09.

Copie de la macro complète :

Sub bon_de_visite_du_jour()

  Dim Inc As Integer, DLig As Long, Lig As Long, Wst As Worksheet
  Dim LaDate As Date, Msg As String, sTmp(3) As String
  Dim sForm As String

'Macro qui s'exécute automatiquement à l'ouverture du fichier pour agrandir la fen^tre et faire un message d'accueil

Application.ScreenUpdating = False
Application.WindowState = xlMaximized

  ' Définir la feuille à vérifier
  Set Wst = ThisWorkbook.Worksheets("Récapitulatif")

  ' Début du message
  sTmp(1) = "Attention #1 bon#2 de visite#2 concernant :" & vbCr
  sTmp(2) = "#3 une date de visite qui commence ce jour le  " & Date

  ' Incrément des formation
  Inc = 0

  ' Dernière ligne de la feuille
  DLig = Wst.Range("B" & Application.Rows.count).End(xlUp).Row

  ' Vérification des réservations
  For Lig = 5 To DLig

    ' Récupérer la date si existe
    If Wst.Range("C" & Lig).Value <> "" Then LaDate = Wst.Range("C" & Lig).Value

    ' Ecart avec la date actuelle < 30 jours
    If DateDiff("d", Date, LaDate) = 0 Then 'And DateDiff("d", Date, LaDate) <= 1 Then

        ' Incrémenter le nombre de formations en alerte
        Inc = Inc + 1

        ' Définir le message

        'sForm = sForm & Wst.Range("B" & Lig).Value & " - n° réservation : " & Lig - 1 & Chr(10)
        sForm = sForm & Wst.Range("D" & Lig).Value & " pour " & Wst.Range("H" & Lig).Value & " (n° " & Wst.Range("A" & Lig).Value & ")" & Chr(10)

        End If
    'End If

  Next Lig

  ' Si aucune réservation ne correspond
  If Inc = 0 Then
  MsgBox ("Pas de bon de visite aujourd'hui")
  End If

  If Inc = 0 Then Exit Sub

  ' Créer le message
  Msg = Replace(Replace(sTmp(1), "#1", IIf(Inc > 1, "les", "la")), "#2", IIf(Inc > 1, "s", ""))
  Msg = Msg & vbCr & sForm
  Msg = Msg & vbCr & vbCr & Replace(sTmp(2), "#3", IIf(Inc > 1, "ont", "a"))

  ' Afficher le message
  MsgBox Msg, vbInformation, "ATTENTION...bon de visite du jour..."

  ' Effacer les varaibles objet
  Set Wst = Nothing

Application.ScreenUpdating = True

End Sub

C'est normal que je n'ai que le bon n°1 qui est extrait car le test ce fait sur le jour présent :

' Vérification des réservations
  For Lig = 5 To DLig

    ' Récupérer la date si existe
    If Wst.Range("C" & Lig).Value <> "" Then LaDate = Wst.Range("C" & Lig).Value

    ' Ecart avec la date actuelle < 30 jours
    If DateDiff("d", Date, LaDate) = 0 Then 'And DateDiff("d", Date, LaDate) <= 1 Then

        ' Incrémenter le nombre de formations en alerte
        Inc = Inc + 1

mais je ne sais pas l'adapter pour une période.

Est-ce qu'il y aurait une personne pour me dire ce que je dois faire ? Merci

Cordialement.

11test-chronologie-des-bons-de-visite-v2.xlsm (35.75 Ko)
Le 26/08/2023 à 04:51

Bonjour,

Attention, cela ne marche pas si la date de fin est antérieure à la date de début comme dans votre exemple.

Option Explicit

Function AvecDateDuJour(ByVal DateDebut As Date, ByVal DateFin As Date) As Boolean

Dim DateEnCours As Date

    AvecDateDuJour = False
    For DateEnCours = DateDebut To DateFin
        If DateEnCours = Date Then
           AvecDateDuJour = True
           Exit Function
        End If
    Next DateEnCours

End Function

Sub Bon_de_visite_du_jour2()

  Dim Inc As Integer
  Dim Msg As String, sTmp(3) As String, sForm As String

  Dim I As Long
  Dim AireDebut As Range, AireFin As Range, AireBon As Range, AireTel As Range

  Set AireDebut = Range("T_recap[Date de la visite]")
  Set AireFin = Range("T_recap[Date fin de visite]")
  Set AireBon = Range("T_recap[N° bon de visite]")
  Set AireTel = Range("T_recap[Tél.]")

  Inc = 0

  For I = 1 To AireDebut.Count
      If AvecDateDuJour(CDate(AireDebut(I)), CDate(AireFin(I))) = True Then
         sForm = sForm & AireFin(I) & " pour " & AireTel(I) & " (n° " & AireBon(I) & ")" & Chr(10)
         Inc = Inc + 1
      End If
  Next I

  ' Si aucune réservation ne correspond
  If Inc = 0 Then
     MsgBox "Pas de bon de visite aujourd'hui !"
     GoTo Fin
  End If

  ' Début du message
  sTmp(1) = "Attention #1 bon#2 de visite#2 concernant :" & vbCr
  sTmp(2) = "#3 une date de visite aujourd'hui " & Date

  ' Créer le message
  Msg = Replace(Replace(sTmp(1), "#1", IIf(Inc > 1, "les", "la")), "#2", IIf(Inc > 1, "s", ""))
  Msg = Msg & vbCr & sForm
  Msg = Msg & vbCr & vbCr & Replace(sTmp(2), "#3", IIf(Inc > 1, "ont", "a"))

  ' Afficher le message
  MsgBox Msg, vbInformation, "ATTENTION...bon de visite du jour..."

  GoTo Fin

Fin:

  ' Effacer les variables objet
  Set AireDebut = Nothing: Set AireFin = Nothing: Set AireBon = Nothing: Set AireTel = Nothing

End Sub
Le 26/08/2023 à 19:32

Ouah Eric Kergresse super ta macro . Je n'aurai pas pensé à faire une fonction car je n'en ai jamais. Est-ce que tu peux m'explique le fonctionnement de ta fonction :

Function AvecDateDuJour(ByVal DateDebut As Date, ByVal DateFin As Date) As Boolean

Dim DateEnCours As Date

    AvecDateDuJour = False
    For DateEnCours = DateDebut To DateFin
        If DateEnCours = Date Then
           AvecDateDuJour = True
           Exit Function
        End If
    Next DateEnCours

End Function

Sujet mis en résolu et merci encore pour ta macro qui me donne le résultat recherché.

Le 27/08/2023 à 03:14

Bonjour,

Cette fonction est utilisable comme n'importe quelle fonction Excel dans ton tableau.

Le principe est relativement simple, on lui donne les paramètres d'entrée entre parenthèses et on lui indique le type de sortie ici booléen. On boucle du début à la fin les dates en entrée dans une variable date et si celle-ci correspond à la date du jour (Date), on change la valeur de la fonction et on quitte la boucle.

Le 27/08/2023 à 14:59

Merci Éric pour cet éclaircissement 🙂

Rechercher des sujets similaires à "extraction fonction periode date"