Microsoft 365 trouver la date la plus récente (uniquement sur le jour) contenue dans ma cellule :

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous,
Je vous souhaite une belle journée :)

Je me permets de revenir vers nos chers ténors en vba pour un besoin particulier qui, selon mes recherche n'a jamais été traité, ni sur le forum, ni sur internet.

Il m'est très difficile d'expliquer mon besoin dans le post. Il est, je crois, clairement montré dans le fichier test que je joins à ma demande.

Si vous aviez la solution vba, ça m'arrangerait bien lol :)
En espérant que ce sera pas trop ch..t à lire.
Je vous remercie vivement,
Amicalement,
lionel,
 

Pièces jointes

  • test_uf_comment.xlsm
    206.5 KB · Affichages: 49
Dernière édition:
Solution
Bonjour Lionel, soan, Yeahou,

Cette solution impose le minimum de contraintes aux dates dans la cellule active :
VB:
Sub DerniereDate()
Dim x$, i%, y$, a(), n%
x = Application.Trim(ActiveCell) 'SUPPRESPACE
For i = 1 To Len(x)
    y = Mid(x, i, 14)
    If y Like "##?##?## ##:##" And IsDate(y) Then ReDim Preserve a(n): a(n) = CDbl(CDate(y)): n = n + 1
Next
If n Then MsgBox "Dernière date " & Format(Application.Max(a), "dd-mm-yy hh:mm")
End Sub
Les renvois à la ligne ne sont pas indispensables.

Il suffit que les dates soient bien des dates formatées "jj-mm-aa hh:mm", le tiret pouvant être un slash /.

A+

mapomme

XLDnaute Barbatruc
Supporter XLD
une commande Vba du type DateSerial(2025, 2, 40) renverra le 12 mars 2025
En cette période de Carême c'est malicieux d'évoquer le nombre 40 qui est le nombre de jours passés par Jésus dans le désert à résister à la tentation. D'où la question : Jésus utilisait-il déjà Excel et DateSerial() pour calculer la date de fin de son épreuve ? Si oui, Excel serait donc bien plus ancien qu'on ne le pense. :D:D
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
tiens, d'ailleurs cette fonction passe tout aussi bien !
VB:
Function Test_Date(Date_Val$) As Boolean
    If Not Date_Val Like "29?02*" Then Exit Function
    If Not Day(DateSerial(Day:=Mid(Date_Val, 1, 2), Month:=Mid(Date_Val, 4, 2), _
        Year:=Mid(Date_Val, 7, 2))) = Day(CDate(Date_Val)) Then Test_Date = True
End Function
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

=>mapomme
Assurément Jésus s'exprimait régulièrement à la foule (sans masque et sans gel)
Mais son expression régulière n'était pas celle que VBA peut comprendre aujourd'hui ;)
VB:
Sub test()
MsgBox TestDate("31/04/2021")
MsgBox TestDate("29/02/2020")
MsgBox TestDate("02-29-2020")
MsgBox TestDate("29/02/2021")
MsgBox TestDate("02-29-2020")
End Sub
Private Function TestDate(s) As Boolean
Dim m, tmp
With CreateObject("vbscript.regexp")
    .Pattern = "[\d]+[\/-][\d]+[\/-][\d]+"
    .Global = True
        For Each m In .Execute(s)
        If IsDate(m.Value) Then
        tmp = CDate(m.Value)
        Exit For
        End If
    Next
End With
TestDate = Len(tmp) > 1
End Function
NB: Testé basiquement (et non point pointilleusement)
 

soan

XLDnaute Barbatruc
Inactif
Bonjour,

à propos de TestDate("12/21/11"), je ne suis pas sûr que ce soit le 21 décembre 2011 : si la date "12/21/11" est traduite dans l'américain originel de VBA, ne serait-ce pas plutôt l'année en premier, donc le 21 novembre 2012 ? (mais j'peux m'tromper, j'en suis pas sûr !)

soan
 
Dernière édition:

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Ceci est d'accord avec moi :
VB:
MsgBox CDate("31/04/25")
et tu as raison ! Mea maxima culpa, ça m'apprendra à réfléchir avant de poster d'autant plus que c'est ce que j'avais évoqué là, double faute ! 🥴😕
[édition2: pour Cdate, je pense à un évaluate qui fait trop bien son boulot
CDateDateToute expression de date valide.
29/02/25 au format anglais remplit bien la condition]
donc il faut tester toutes les chaines déja reconnues comme date et là, ça fonctionne:
VB:
Sub DerniereDate_Job_Modif()
    Dim x$, i%, y$, A(), n%, v$, w%, z%
    v = "##?##?## ##:##" 'format à analyser
    z = Len(v): w = z - 1
    x = Application.Trim(ActiveCell.Value) 'SUPPRESPACE
    For i = 1 To Len(x) - w
        y = Mid(x, i, z)
        If y Like v And IsDate(y) Then i = i + w: If Test_Date(Left(y, 8)) Then ReDim Preserve A(n): A(n) = CDbl(CDate(y)): n = n + 1
    Next
    If n Then MsgBox "Dernière date " & Format(Application.Max(A), "dd-mm-yy hh:mm")
End Sub
Function Test_Date(Date_Val$) As Boolean
    If IsDate(Date_Val) Then If Day(DateSerial(Day:=Mid(Date_Val, 1, 2), Month:=Mid(Date_Val, 4, 2), _
        Year:=Mid(Date_Val, 7, 4))) = Day(CDate(Date_Val)) Then Test_Date = True
End Function
pour @mapomme , la fonction Test_Date doit correspondre:
[édition: modification fonction Test_Date au post 40]
Code:
Sub Test()
Dim z$
z = "31/04/2021": MsgBox z & " : " & Test_Date(z)
z = "29/02/2020": MsgBox z & " : " & Test_Date(z)
z = "29/02/2021": MsgBox z & " : " & Test_Date(z)
z = "02-29-2020": MsgBox z & " : " & Test_Date(z)
z = "29-02-20": MsgBox z & " : " & Test_Date(z)
z = "29-02-21": MsgBox z & " : " & Test_Date(z)
z = "12/21/11": MsgBox z & " : " & Test_Date(z)
z = "31/04/25": MsgBox z & " : " & Test_Date(z)
z = "31-04-25": MsgBox z & " : " & Test_Date(z)
z = "30-04-25": MsgBox z & " : " & Test_Date(z)
End Sub
 
Dernière édition:

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Bonjour le fil, le forum

fonction Test_Date modifiée, analyse les dates sur 8 ou 10 caractères, renvoie vrai si c'est une date valide au format DD?MM?YY(YY), pas trouvé de moyen de la mettre en défaut.

Cordialement
VB:
Function Test_Date(Date_Val$) As Boolean
    If IsDate(Date_Val) Then
        If Format(DateSerial(Day:=Mid(Date_Val, 1, 2), Month:=Mid(Date_Val, 4, 2), _
            Year:=Mid(Date_Val, 7, 4)), "DD/MM/YYYY") = Format(CDate(Date_Val), "DD/MM/YYYY") Then Test_Date = True
    End If
End Function
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
et pour usine à gaz, la modification de ma première sub pour utiliser cette nouvelle version de Test_Date
VB:
Sub Trouver_Date_Max()
    Dim Tableau_en_Cours, Date_Max As Date, Date_en_Cours As Date, Compteur% 'définition des variables
    Tableau_en_Cours = Split(ActiveCell.Value, vbLf) 'création du tableau de données
    For Compteur = LBound(Tableau_en_Cours, 1) To UBound(Tableau_en_Cours, 1) 'boucle sur tableau
        If IsDate(Left(LTrim(Tableau_en_Cours(Compteur)), 14)) Then If Test_Date(Left(LTrim(Tableau_en_Cours(Compteur)), 8)) Then _
            Date_en_Cours = Left(LTrim(Tableau_en_Cours(Compteur)), 14) Else _
            MsgBox Left(LTrim(Tableau_en_Cours(Compteur), 8)) & " n'est pas une date valide", vbOKOnly + vbCritical
        If Date_en_Cours > Date_Max Then Date_Max = Date_en_Cours 'mise à jour date max
    Next Compteur
    If Date_Max = 0 Then MsgBox "Pas de date trouvée", vbOKOnly + vbInformation Else _
        MsgBox "La dernière date saisie est le " & Format(Date_Max, "DDDD DD MMMM YYYY " & Chr(34) & "à" & Chr(34) & " HH" & Chr(34) & "h" & Chr(34) & "MM") & ".", vbOKOnly + vbInformation             'retour
End Sub
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Une fonction personnalisée de ma pomme qui renvoie Faux si le texte ne représente pas une date à la française, sinon renvoie la date au format date.
L'expression texte date est assez libre. Quelques restrictions : les séparateurs au sein de la date "texte" doivent être identiques et différents de l'espace, d'un chiffre ou des deux points ":".
 

Pièces jointes

  • Usine à gaz- date la plus récente- v3.xlsm
    20.4 KB · Affichages: 5

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Une fonction personnalisée de ma pomme qui renvoie Faux si le texte ne représente pas une date à la française, sinon renvoie la date au format date.
petit bug ou alors grosse anticipation
Image2.png

je vais la donner à mon banquier pour calculer le début de mes remboursements de crédit !;)

[édition: j'adore l'idée de la fonction 😍]
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
314 776
Messages
2 112 846
Membres
111 677
dernier inscrit
Toreddu