[VBA-E]Formats de dates, Trier, ajouter - A compléter

Version imprimable

A COMPLÉTER PAR LES GENTILS MEMBRES ÉCLAIRÉS DU FORUM

"Ne pas se laisser en....er la vie par des problèmes de format de dates" est l'objet de cette discussion.

Dans le but de réunir le maximum de renseignements sur l'utilisation, la manipulation, la conversion, les calculs et la mise en forme des dates, j'ai commencé à placer ici quelques procédures offrant une solution à quelques-uns des nombreux problèmes de date rencontrés ici et là.

Divers formats de dates pour arriver au même résultat. Demo

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
Sub FormaterReformaterUneDateFormatee()
Dim LesDates, UneDate, i As Byte
LesDates = Array("16/02/2006", "02/16/07", "2008/2/16", "16 février 2009", "16-02-2010", "16-fév-2011")
For i = 0 To UBound(LesDates) 
    UneDate = CDbl(CDate(LesDates(i)))
    Cells(i + 1, 1).Value = "'" & LesDates(i) 'le vieux format
    Cells(i + 1, 2).Value = Format(UneDate, "dd mmmm yyyy") 'le nouveau
Next
 
'Le temps sous ses différentes  composantes
Dim LaDate As Date
Dim msg As String
    LaDate = Now        'ou toute autre date en format jj/mm/aa
    msg = "'= Format(CDbl(LaDate), " & """dd mmmm yyyy""" & ") & Time"
    Cells(i + 1, 1).Offset(1, 0).Value = msg
    Cells(i + 1, 1).Offset(1, 1).Value = Format(CDbl(LaDate), "dd mmmm yyyy") & " " & Time
    Cells(i + 1, 1).Offset(1, 2).Value = "Date et heure"
 
    msg = "'= Time"
    Cells(i + 1, 1).Offset(2, 0).Value = msg
    Cells(i + 1, 1).Offset(2, 1).Value = Time
    Cells(i + 1, 1).Offset(2, 2).Value = "Heure non formatée"
 
    msg = "'= Format(CDate(LaDate), " & """dddd dd mmm yyyy""" & ")"
    Cells(i + 1, 1).Offset(3, 0).Value = msg
    Cells(i + 1, 1).Offset(3, 1).Value = Format(CDate(LaDate), "dddd dd mmm yyyy")
    Cells(i + 1, 1).Offset(3, 2).Value = "Le jour et la date, un des nombreux formats"
 
    msg = "'= Format(CDate(LaDate), " & """dddd""" & ")"
    Cells(i + 1, 1).Offset(4, 0).Value = msg
    Cells(i + 1, 1).Offset(4, 1).Value = Format(CDate(LaDate), "dddd")
    Cells(i + 1, 1).Offset(4, 2).Value = "Le jour de la semaine"
 
    msg = "'= Weekday(Now, 2)"
    Cells(i + 1, 1).Offset(5, 0).Value = msg
    Cells(i + 1, 1).Offset(5, 1).Value = Weekday(Now, 2)
    Cells(i + 1, 1).Offset(5, 2).Value = "Numéro du jour de la semaine si le premier jour de la semaine est un lundi"
 
    msg = "'= Weekday(Now, 1)"
    Cells(i + 1, 1).Offset(6, 0).Value = msg
    Cells(i + 1, 1).Offset(6, 1).Value = Weekday(Now, 1)
    Cells(i + 1, 1).Offset(6, 2).Value = "Numéro du jour de la semaine si le premier jour est un dimanche"
 
    msg = "'= DateDiff(" & """d""" & ", " & """1/1/2007""" & ", Now)"
    Cells(i + 1, 1).Offset(7, 0).Value = msg
    Cells(i + 1, 1).Offset(7, 1).Value = DateDiff("d", "1/1/2007", Now)
    Cells(i + 1, 1).Offset(7, 2).Value = "Numéro du jour dans l'année"
 
    msg = "'= DatePart(" & """ww""" & ", " & """4/4/2009""" & ", 2, vbFirstFourDays)"
    Cells(i + 1, 1).Offset(8, 0).Value = msg
    Cells(i + 1, 1).Offset(8, 1).Value = DatePart("ww", "4/4/2009", 2, vbFirstFourDays)
    Cells(i + 1, 1).Offset(8, 2).Value = "Numéro de semaine si la semaine commence le lundi"
 
    msg = "'= DatePart(" & """ww""" & ", " & """4/4/2009""" & ", 1, vbFirstFourDays)"
    Cells(i + 1, 1).Offset(9, 0).Value = msg
    Cells(i + 1, 1).Offset(9, 1).Value = DatePart("ww", "4/4/2009", 1, vbFirstFourDays)
    Cells(i + 1, 1).Offset(9, 2).Value = "Numéro de semaine si la semaine commence le dimanche"
End Sub

Il est parfois intéressant de savoir que DateDiff arrondit les années. Démo :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Fonction_DateDiff()
Dim LesSecondes, LesSeconde As Double, dateref As Date, NbAnnées As Integer
Dim année As Double, mois As Double, Jour As Double
Dim DateDépart As Date, DateToday As Date
    dateref = "27/10/2000"
    NbAnnées = DateDiff("yyyy", dateref, Now)
 
    'Vérif
    'Syntaxe 1 pour convertir année, mois, jour en N° de série
    année = CDbl(Year(dateref))
    mois = CDbl(Month(dateref))
    Jour = CDbl(Day(dateref))
    'Vous avez réussi à séparer le jour du mois de l'année,
    'il reste juste à tout réunir, ce que propose DateSerial
    DateDépart = DateSerial(année, mois, Jour)
 
    'Et en beaucoup plus simple...
    DateDépart = CDbl(CDate(dateref))
 
    'Syntaxe 2
    année = Val(Format(Now, "yy"))
    mois = Val(Format(Now, "mm"))
    Jour = Val(Format(Now, "dd"))
    DateToday = DateSerial(année, mois, Jour)
    'Plus simple...
    DateToday = Now
 
    MsgBox "Date départ : " & DateDépart & vbTab & "Date arrivée : " & DateToday & _
    vbCr & vbCr & "DateDiff renvoie " & FormatNumber(NbAnnées, "000,00") & " ans" & _
    vbCr & "mais..." & vbCr & "une soustraction année - année donne " & _
    Format(DateToday - DateDépart, "yy") & " ans, " & _
    Format(DateToday - DateDépart, "mm") & " mois et " & _
    Format(DateToday - DateDépart, "dd") & " jours", vbOKOnly, "Test"
 
    'Syntaxe 3 La même chose
    DateToday = Now
    DateDépart = CDbl(CDate(dateref))
    MsgBox "La même chose mais plus simple " & vbCr & Format(DateToday - DateDépart, "yy") & " ans, " & _
    Format(DateToday - DateDépart, "mm") & " mois et " & _
    Format(DateToday - DateDépart, "dd") & " jours", vbOKOnly, "Test"
 
End Sub

Par défaut le 1er jour de la semaine est un dimanche. Démo

Code:

1
2
3
4
5
6
Sub LesJoursDansLordre()
Dim NoSemaine, i As Byte
    For i = 1 To 7
        MsgBox Format(i, "dddd")
    Next
End Sub

'Un calendrier des seuls jours ouvrés. Une feuille par mois

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub CalendrierJoursOuvrés()
Dim ok As Boolean, jf As Boolean, JoursFériés As Variant, k As Byte
Dim i As Integer, j As Integer, NoLigne As Integer, dateref As Date
    Application.DisplayAlerts = False
    'Suppression de toutes les feuilles du classeur sauf une
    ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
    For i = ActiveWorkbook.Worksheets.Count - 1 To 1 Step -1
        Worksheets(i).Delete
    Next
    JoursFériés = Array("", "1 janvier 2007", "28 mars 2007", "1 mai 2007", "8 mai 2007", "17 mai 2007", "28 mai 2007", "14 juillet 2007", "15 août 2007", "1 novembre 2007", "11 novembre 2007", "25 décembre 2007")
    'On nomme la feuille qui reste (janvier)
    ActiveSheet.Name = Format(DateSerial(2007, 1, 1), "mmmm") 
    NoLigne = 2
    For i = 1 To 365
        dateref = DateSerial(2007, 1, i)
        'Création de la feuille du mois
        'La feuille de janvier existe, on l'exclut : C'est le 1er du mois, mois > janvier
        If Format(dateref, "dd") = "01" And Month(dateref) > 1 Then
            NoLigne = 2
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveWorkbook.ActiveSheet.Name = Format(dateref, "mmmm")
        End If
        jf = False 'Exclusion des jours fériés
        For k = 1 To UBound(JoursFériés)
            jf = jf Or InStr(Format(CDate(dateref), "dd mmmm yyyy"), JoursFériés(k)) <> 0
            If jf Then Exit For 'C'est un jour férié
        Next k
        If Format(Weekday(dateref), "dddd") <> "samedi" And _
            Format(Weekday(dateref), "dddd") <> "dimanche" And _
            Not jf Then
            ActiveSheet.Cells(NoLigne, 1).Formula = UCase(Left(Format(dateref, "dddd"), 1))
            ActiveSheet.Cells(NoLigne, 2).Formula = Format(dateref, "dd")
            NoLigne = NoLigne + 1
        End If
    Next
End Sub

....................................................A compléter.
DateAdd ?

Liens vers d'autres solutions sur les dates
Jours ouvrés : Connaître la date vraie en ajoutant des jours ouvrés à une date

IsDate

Tester une donnée / une cellule, pour savoir si c'est une date

Code:

1
2
3
4
5
6
7
8
Sub DateOuPasDateLaDate()
Dim LesDates, i As Byte
    LesDates = Array("16/02/2006", "02/16/07", "2008/2/16", "16 février 2009", _
    "16-feb-2011", "16-02-2010", "16-fév-2011", "16022007", "02 16 2012")
    For i = 0 To UBound(LesDates)
         MsgBox LesDates(i) & "  " & IsDate(LesDates(i))
    Next
End Sub

Trier une plage de données selon la date

Consiste à formater la colonne des dates en nombre, à trier, puis à re-formater la colonne

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub TrierSelonLaDate()
Dim ColDates As Integer
Dim f1 As Worksheet
Set f1 = Worksheets("Feuil1")
    ColDates = 9
    f1.Columns(ColDates).NumberFormat = "0"
    f1.Range("A1").CurrentRegion.Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    f1.Columns(ColDates).NumberFormat = "dd/mm/yyyy"
End Sub

Divers formats de dates -> Format, DateSerial, Year, Month, Day...

Exemples de formats (non exclusifs)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub FormaterUneDate()
Dim LaDate As Variant, UneDate As Date, UneAnnée As Integer
Dim UnMois As Byte, UnJour As Byte, NoDeSerie As Long
 
    LaDate = Now                                    '11/04/2007 09:05:35
    Debug.Print LaDate
    LaDate = Format(Now, "dd/mm/yyyy")              '11/04/2007
    Debug.Print LaDate
    LaDate = Format(LaDate, "dd mm yyyy")           '11 04 2007
    Debug.Print LaDate
    LaDate = Format(LaDate, "d/m/yy")               '11/4/07
    Debug.Print LaDate
    LaDate = Format(LaDate, "dddd dd mmmm yyyy")    'mercredi 11 avril 2007
    Debug.Print LaDate
 
    UneDate = "11/04/2007" 'ou = Cells(NoLigne, NoCol).value
    UneAnnée = Year(CDate(UneDate))                 '2007
    Debug.Print UneAnnée
    UnMois = Month(CDate(UneDate))                  '4
    Debug.Print UnMois
    UnJour = Day(CDate(UneDate))                    '11
    Debug.Print UnJour
 
    LaDate = DateSerial(UneAnnée, UnMois, UnJour)   '11/04/2007
    Debug.Print LaDate
 
    NoDeSerie = CDbl(LaDate)          '39183 -> Utile pour trier selon la date
    Debug.Print NoDeSerie
    LaDate = Format(LaDate, "dd-mmm-yyyy")          '11-avr-2007
    Debug.Print LaDate
    LaDate = Format(NoDeSerie, "dd/mm/yyyy")        '04/11/2007
    Debug.Print LaDate
End Sub

A toutes fins utiles

Quelques tableaux utiles

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub QuelquesTableauxUtiles()
Dim LesMois, TablMoisU, TablMoisL, LesJours, MoisAnglais, Tableau, DateAnglaise, UneDate
Dim i As Integer
    LesMois = Array("", "janvier", "février", "mars", "avril", "mai", "juin", _
           "juillet", "août", "septembre", "octobre", "novembre", "décembre")
    TablMoisU = Array("", "JAN", "FÉV", "MAR", "AVR", "MAI", "JUI", "JUIL", _
           "AOÛ", "SEP", "OCT", "NOV", "DÉC")
    TablMoisL = Array("", "jan", "fév", "mar", "avr", "mai", "jui", "juil", _
           "aoû", "sep", "oct", "nov", "déc")
    LesJours = Array("", "Dimanche", "lundi", "mardi", "mercredi", "jeudi", _
           "vendredi", "samedi")
    MoisAnglais = Array("", "jan", "feb", "mar", "apr", "may", "jun", "jul", _
           "aug", "sep", "oct", "nov", "dec")
 
'Exemples d'utilisations
    UneDate = "11/04/2007" 'ou = Cells(NoLigne, NoCol).value
    UnMois = LesMois(Month(CDate(UneDate)))         'avril
    Debug.Print UnMois
    UnJour = LesJours(Day(CDate(UneDate)) Mod 7)    'mercredi
    Debug.Print UnJour
 
    DateAnglaise = "apr-11-2007"
    Tableau = Split(DateAnglaise, "-")
    For i = 1 To UBound(MoisAnglais)
        If Tableau(0) = MoisAnglais(i) Then Exit For
    Next
    UnDate = Format(Replace(DateAnglaise, MoisAnglais(i), _
             TablMoisL(i)), "dd/mm/yyyy") '11/04/2007
    Debug.Print UneDate
    'ou
    UneDate = Tableau(1) & " " & LesMois(i) & " " & Tableau(2)      '11 avril 2007
    Debug.Print UneDate
    'ou
    UneDate = Replace(DateAnglaise, MoisAnglais(i), TablMoisL(i))   'avr-11-2007
    Debug.Print UneDate
    UneDate = Format(UneDate, "dd-mmm-yyyy")                        '11-avr-2007
    Debug.Print UneDate
 
    'Quel sera le jour du 1er de chaque mois ?
    For i = 1 To 12
        UneDate = Format(CDate("01-" & TablMoisU(i) & "-2007"), "dddd dd mmmm yyyy")
        Debug.Print UneDate
    Next
 
    'En plus simple ^^^
    For i = 1 To 12
        UneDate = Format(CDate("01-" & i & "-2007"), "dddd dd mmmm yyyy")
        Debug.Print UneDate
    Next
 
End Sub

ATTENTION :

Code:

1
2
3
Msgbox cdate("1/15/2007") 'donne sur un PC français "15/1/2007"
'est l'équivalent de :
Msgbox cdate("15/1/2007") 'donne aussi sur un PC français "15/1/2007"

C'est pourquoi il est souvent utile de passer par le Numéro de série de la date avant de le formater.

Quelques formats

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub FormatDesDates()
Dim LaDate As Date, LeJour, LeMois, Lannée
    LaDate = Now()
    LeJour = Format(LaDate, "dd")
    LeMois = Format(LaDate, "mm")
    Lannée = Format(LaDate, "yyyy")
    Cells(1, 1).Value = Now()
    Cells(2, 1).Value = LeJour
    Cells(3, 1).Value = LeMois
    Cells(4, 1).Value = Lannée
    Cells(5, 1).Value = Format(CDate(Cells(1, 1).Value), "dd")
    Cells(6, 1).Value = Format(CDate(Cells(1, 1).Value), "mm")
    Cells(7, 1).Value = Format(CDate(Cells(1, 1).Value), "yyyy")
    MsgBox DateSerial(Val(Lannée), Val(LeMois), Val(LeJour)) 'La date
    MsgBox CDbl(DateSerial(Val(Lannée), Val(LeMois), Val(LeJour))) 'No de série
End Sub

Il arrive parfois que lorsque l'on importe un fichier texte par macro, les dates sont soient au format anglais, soit au format anglais :) donc qu'elle s'écrivent par exemple soit "26/06/2007" soit "06/26/2007" ce qui fait que ça fausse un peu les résultats.
Pour cela, j'ai créé cette macro :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Private Sub ChangeDate(ColonneChanges As Long) Dim j As String Dim m As String Dim a As String Dim i As Long Dim MaDate As Date For i = 2 To Range("B2").End(xlDown).Row If Cells(i, ColonneChanges).Value = "" Then Cells(i, ColonneChanges).Value = "" ElseIf Cells(i, ColonneChanges).NumberFormat = "General" Then j = Left(Cells(i, ColonneChanges).Value, 2) m = Mid(Cells(i, ColonneChanges).Value, 4, 2) a = Mid(Cells(i, ColonneChanges).Value, 7, 4) MaDate = DateSerial(a, m, j) Cells(i, ColonneChanges).Value = MaDate Else m = Left(Cells(i, ColonneChanges).Value, 2) j = Mid(Cells(i, ColonneChanges).Value, 4, 2) a = Mid(Cells(i, ColonneChanges).Value, 7, 4) MaDate = DateSerial(a, m, j) Cells(i, ColonneChanges).Value = MaDate End If Cells(i, ColonneChanges).NumberFormat = "dd/mm/yyyy" Next i End Sub
Pour une petite explication, quand vous rencontrez ce genre de souci, si vous regardez d'un peu plus près, lorsque vous regardez le format de la cellule, elle est soit au format de date, soit au format standard :) et quand elle est au format standard, en fait elle est dans le bon format, alors que quand la cellule est au format date, elle le met au format américain :)

Cordialement.