XL 2013 Lister les dates comprises entre 2 dates Date1 et Date2

Fred0o à dit:

Bonjour Ananas94.

Correction du code a tester :

VB:

Sub test()
    MsgBox ListerDatesEntre2Dates(CDate("01/01/2021"), CDate("06/01/2021")) ' On liste toutes les dates comprises entre le 01/01/2021 et le 06/01/2021 inclus
End Sub


Function ListerDatesEntre2Dates(Date1 As Date, Date2 As Date) As String
    Dim DateCible As Date 'DateCible est la date comprise entre Dtae1 et Date2 que l'on étudie successivement
    Dim i% 'Numéro des jours
    Dim DateTxt As String
    For i = 1 To DateDiff("d", Date1, Date2, vbMonday) + 1 'Nombre de jours de différence entre date1 et Date2. On ajoute 1 car la fonction DateDiff ne compte pas Date1 dans le décompte de jours.
        If i = 1 Then
            DateTxt = Date1
            DateCible = Date1
        ElseIf i > 1 Then
            DateCible = DateAdd("d", 1, DateCible)
            DateTxt = DateTxt & Chr(10) & DateCible
        End If
    Next i
    ListerDatesEntre2Dates = DateTxt
End Function

Cliquez pour agrandir...

Roblochon à dit:

Bonjour,

Cdate (1 /1/ 2021) va tenter de resoudre 1 divisé par 1 divisé par 2021 soit 0,00049480455220188
qui éventuellement peut passé pour une heure mais pas une date.

CDate("1/1/2021") donnera une date.

VB:

Sub test()
   '
   ' Afficher les dates du tableau retourné par la fonction
   MsgBox Join(ListerDatesEntre2Dates(CDate("1/1/2021"), CDate("6/1/2021")), vbCrLf) ' On liste toutes les dates comprises entre le 01/01/2021 et le 06/01/2021 inclus
End Sub

Function ListerDatesEntre2Dates(Date1 As Date, Date2 As Date) As Variant

    Dim Nb As Integer, i As Integer 'Nombre de dates, compteur de boucle
    Dim t ' tableau à renvoyer avec la liste de dates
 
    '
    ' Déterminer le nombre de dates
    Nb = Date2 - Date1 + 1
    '
    ' Prévoir un tableau de retour en conséquence
    ReDim t(1 To Nb)
    '
    ' Remplir le tableau avec les dates
    For i = 1 To Nb
        t(i) = Date1 - 1 + i
    Next i
     
    ListerDatesEntre2Dates = t

End Function

Cordialement

Cliquez pour agrandir...