Autres projet fonction de reconnaissance format date

patricktoulon

patricktoulon

XLDnaute Barbatruc
bonjour a tous
dans une autre discussion concernant Ado je me suis rendu compte que la restitution de la requete était un peu légère
j'ai donc le projet de créer une fonction de reconnaissance de date en string puisque que ado renvoie du string

j'ai donc créé une sub qui fonctionne (que je voudrais transformer en fonction et aménager ou implémenter autrement le select case

voici donc le départ de l'idée
VB: 
Sub test2()
    Dim a, forme
    'a = "20-mars-2020 20:52:32"
    'a = "vendredi 20-mars-2020 20:52:32"
    a = "ven. 20-mars-2020 20:52:32"
    'a = "20 mars 2020 20:52:32"
    'a = "20/03/2020 20:52:32"
    'a = "20/03/2020"
    
    If Not IsDate(a) Then
        If Not IsNumeric(Left(a, 3)) Then ddd = "ddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Not Left(a, 5) Like "*.*" Then ddd = "ddddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Left(a, 5) Like "*.*" Then ddd = "ddd. ": b = Mid(a, InStr(1, a, " ") + 1)
        If b <> "" Then a = b
    End If
    If IsDate(a) Then
        Select Case True
        Case Format(a, "dd mmmm yyyy") = a: a = CDate(a): forme = "dd mmmm yyyy"
        Case Format(a, "dd mmm yyyy") = a: a = CDate(a): forme = "dd mmm yyyy"
        Case Format(a, "dd mmm yyyy hh:nn:ss") = a: forme = "dd mmm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd-mmm-yyyy hh:nn:ss") = a: forme = "dd-mmm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd mm yyyy hh:nn:ss") = a: forme = "dd mm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd/mm/yyyy hh:nn:ss") = a: forme = "dd/mm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd/mm/yyyy") = a: forme = "dd/mm/yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd-mm-yyyy") = a: forme = "dd-mm-yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd/mm/yy") = a: forme = "dd/mm/yy": a = DateValue(a): ddd = ""
            'etc....
        End Select
    End If
    With [A22]
        .Value = a
        .NumberFormat = ddd & forme
    End With
End Sub
 
Trier par date Trier par votes
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bon j'avance
la fonction doit retourner plusieur chose en fait
  1. si oui ou non c'est une date
  2. si il y a un timevalue
  3. la date
  4. et le format
pour cela j'ai pris le parti de travailler avec des variables en callback
( j'injecte des variable vides qui me reviennent renseignées) donc réutilisation dans la sub d'appel

donc episode 2
c'est maintenant une fonction
VB: 
Sub test2()
    Dim a, forme$, x As Boolean, dat As Date, T$, AA$, timeval
    'a = "20-mars-2020 20:52:32"
    'a = "vendredi 20-mars-2020 20:52:32"
    a = "ven. 20-mars-2020 20:52:32"
    'a = "20 mars 2020 20:52:32"
    'a = "20/03/2020 20:52:32"
    'a = "20/03/2020"
    AA = a
    x = GetDateFormat(a, dat, timeval, forme)
    If x = True Then
        T = AA & vbCrLf & "-----------------------" & vbCrLf
        T = T & "date : " & CStr(x) & vbCrLf
        T = T & "date : " & Format(dat, "dd/mm/yyyy") & vbCrLf
        T = T & "time value : " & timeval & vbCrLf
         T = T & "format :" & forme & vbCrLf
        MsgBox T

    Else
    End If
End Sub

Function GetDateFormat(a, dat, timeval, forme)
    forme = ""
    If Not IsDate(a) Then
        If Not IsNumeric(Left(a, 3)) Then ddd = "ddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Not Left(a, 5) Like "*.*" Then ddd = "ddddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Left(a, 5) Like "*.*" Then ddd = "ddd. ": b = Mid(a, InStr(1, a, " ") + 1)
        If b <> "" Then a = b
    End If
    If IsDate(a) Then
        Select Case True
        Case Format(a, "dd mmmm yyyy") = a: a = CDate(a): forme = "dd mmmm yyyy"
        Case Format(a, "dd mmm yyyy") = a: a = CDate(a): forme = "dd mmm yyyy"
        Case Format(a, "dd mmm yyyy hh:nn:ss") = a: forme = "dd mmm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mmm-yyyy hh:nn:ss") = a: forme = "dd-mmm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd mm yyyy hh:nn:ss") = a: forme = "dd mm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mm/yyyy hh:nn:ss") = a: forme = "dd/mm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mm/yyyy") = a: forme = "dd/mm/yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd-mm-yyyy") = a: forme = "dd-mm-yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd/mm/yy") = a: forme = "dd/mm/yy": a = DateValue(a): ddd = ""
            'etc....
        End Select
    End If
    dat = a
    forme = ddd & forme
    GetDateFormat = IsDate(a)
End Function
ou il est mon @Dudu2 là y dors ou quoi? ;)
 
Dernière édition:
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Surtout pour te saluer @patricktoulon :) et aussi un peu pour pinailler...:D

Je pense que ta fonction n'a pas à voir avec du callback. Tu utilises tout simplement le passage des arguments "par référence" et non "par valeur" (notion classique dans le monde des sous-programmes et fonctions). Par défaut, VBA utilise le mode par référence.

nota : on laisse dormir le Dudu2 !
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
bon j'avance
ici on a un panel des formats les plus courants qui sont reconnus
les formats sont par paragraphe qui consiste dans chaque ligne a changer le séparateur
y a t il un moyen de simplifier ceci en terme de code
VB: 
Sub test2()
    Dim a, forme$, x As Boolean, dat As Date, T$, AA$, timeval
    'a = "20-mars-2020 20:52:32"
    'a = "vendredi 20-décembre-2020 20:52:32"
    a = "vendredi 20-décembre-2020 20:52"
    'a = "vend 20-décembre-2020 20:52"
    'a = "ven. 20-mars-2020 20:52:32"
    'a = "20 mars 2020 20:52:32"
    'a = "20/03/2020 20:52:32"
    'a = "20/03/2020"
    AA = a
    x = GetDateFormat(a, dat, timeval, forme)
    If x = True Then
        T = AA & vbCrLf & "-----------------------" & vbCrLf
        T = T & "date : " & CStr(x) & vbCrLf
        T = T & "date : " & Format(dat, "dd/mm/yyyy") & vbCrLf
        T = T & "time value : " & timeval & vbCrLf
        T = T & "format :" & forme & vbCrLf
        MsgBox T

    Else
    End If
End Sub

Function GetDateFormat(a, dat, timeval, forme)
    forme = ""
    If Not IsDate(a) Then    'si jour en lettre(abrégé ou complet)
        If Not IsNumeric(Left(a, 3)) Then ddd = "ddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Not Left(a, 5) Like "*.*" Then ddd = "ddddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Left(a, 5) Like "*.*" Then ddd = "ddd. ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Left(a, 5) Like "* *" Then ddd = "ddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If b <> "" Then a = b
    End If
    If IsDate(a) Then
        Select Case True
            'test format jour mois en lettre complet année
        Case Format(a, "dd mmmm yyyy") = a: a = CDate(a): forme = "dd mmmm yyyy"
        Case Format(a, "dd-mmmm-yyyy") = a: a = CDate(a): forme = "dd-mmmm-yyyy"
        Case Format(a, "dd/mmmm/yyyy") = a: a = CDate(a): forme = "dd-mmmm-yyyy"
        Case Format(a, "dd.mmmm.yyyy") = a: a = CDate(a): forme = "dd.mmmm.yyyy"

            'test format jour mois en lettre abrégé année
        Case Format(a, "dd mmm yyyy") = a: a = CDate(a): forme = "dd mmm yyyy"
        Case Format(a, "dd-mmm-yyyy") = a: a = CDate(a): forme = "dd-mmm-yyyy"
        Case Format(a, "dd/mmm/yyyy") = a: a = CDate(a): forme = "dd/mmm/yyyy"
        Case Format(a, "dd.mmm.yyyy") = a: a = CDate(a): forme = "dd.mmm.yyyy"

            'test format jour mois en lettre complet année heure minute
        Case Format(a, "dd.mmmm.yyyy hh:nn") = a: forme = "dd.mmmm.yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mmmm-yyyy hh:nn") = a: forme = "dd-mmmm-yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mmmm/yyyy hh:nn") = a: forme = "dd.mmmm.yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd mmmm yyyy hh:nn") = a: forme = "dd mmmm yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)


            'test format jour mois en lettre complet année heure minute seconde
        Case Format(a, "dd mmmm yyyy hh:nn:ss") = a: forme = "dd mmmm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mmmm-yyyy hh:nn:ss") = a: forme = "dd-mmmm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mmmm/yyyy hh:nn:ss") = a: forme = "dd/mmmm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd.mmmm.yyyy hh:nn:ss") = a: forme = "dd.mmmm.yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)

            'test format jour mois en lettre abrégé année heure minute
        Case Format(a, "dd mmm yyyy hh:nn") = a: forme = "dd mmm yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mmm-yyyy hh:nn") = a: forme = "dd-mmm-yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd.mmm.yyyy hh:nn") = a: forme = "dd.mmm.yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mmm/yyyy hh:nn") = a: forme = "dd/mmm/yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)


            'test format jour mois en lettre abrégé année heure minute seconde
        Case Format(a, "dd mmm yyyy hh:nn:ss") = a: forme = "dd mmm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mmm-yyyy hh:nn:ss") = a: forme = "dd-mmm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd.mmm.yyyy hh:nn:ss") = a: forme = "dd.mmm.yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mmm/yyyy hh:nn:ss") = a: forme = "dd/mmm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)


            'test format jour mois en numeric  année heure minute
        Case Format(a, "dd mm yyyy hh:nn") = a: forme = "dd mm yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mm/yyyy hh:nn") = a: forme = "dd/mm/yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mm-yyyy hh:nn") = a: forme = "dd-mm-yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd.mm.yyyy hh:nn") = a: forme = "dd.mm.yyyy hh:mm": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)

            'test format jour mois en lnumeric  année heure minute seconde
        Case Format(a, "dd mm yyyy hh:nn:ss") = a: forme = "dd mm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd/mm/yyyy hh:nn:ss") = a: forme = "dd/mm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd-mm-yyyy hh:nn:ss") = a: forme = "dd-mm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)
        Case Format(a, "dd.mm.yyyy hh:nn:ss") = a: forme = "dd.mm.yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)


            'format classique les plus courants
        Case Format(a, "dd/mm/yyyy") = a: forme = "dd/mm/yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd-mm-yyyy") = a: forme = "dd-mm-yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd mm yyyy") = a: forme = "dd mm yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd.mm.yyyy") = a: forme = "dd.mm.yyyy": a = DateValue(a): ddd = ""


            'test format jour mois année  en 2 digits
        Case Format(a, "dd/mm/yy") = a: forme = "dd/mm/yy": a = DateValue(a): ddd = ""
        Case Format(a, "dd-mm-yy") = a: forme = "dd-mm-yy": a = DateValue(a): ddd = ""
        Case Format(a, "dd mm yy") = a: forme = "dd mm yy": a = DateValue(a): ddd = ""
        Case Format(a, "dd.mm.yy") = a: forme = "dd.mm.yy": a = DateValue(a): ddd = ""



            'etc....
        End Select
    End If
    dat = a
    forme = ddd & forme
    GetDateFormat = IsDate(a)
End Function
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Bonjour @patricktoulon

J'ai pensé à l'utilisation d'une Regex avec construction de Patern :
'a = "20-mars-2020 20:52:32"
'a = "vendredi 20-décembre-2020 20:52:32"
a = "vendredi 20-décembre-2020 20:52"
'a = "vend 20-décembre-2020 20:52"
'a = "ven. 20-mars-2020 20:52:32"
'a = "20 mars 2020 20:52:32"
'a = "20/03/2020 20:52:32"
'a = "20/03/2020"

Je suis peux être pas dans le vrai mais c'est une idée ?
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Bonjour laurent
oui si tu veux fait moi un exemple (attention pas les usines a gaz dont tu es friand 🤪 )
et je verrai si c'est judicieux de prendre ce chemin
il y a de l'idée effectivement
on doit pouvoir disséquer les segments dans le resultat intermediaire S1 ET S2 ET S3 si existent afin de pouvoir tester si S2 est une date valide
 
Vote positif 0 Vote négatif
dysorthographie

dysorthographie

XLDnaute Accro
bonjour Patrick,
voila ce que j'ai proposé,à une autre époque , sur un autre forum !
VB: 
Function TrouveType(V)
TrouveType =trim(V)
If IsDate(TrouveType) And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ",", ".")) Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
End Function

Function TrouveTypeSql(V)
TrouveTypeSql = Trim("" & V)
If Trim("" & TrouveTypeSql) = "" Then TrouveTypeSql = "Null": Exit Function
If IsDate(TrouveTypeSql) And InStr(TrouveTypeSql, "/") <> 0 And InStr(TrouveTypeSql, ":") <> 0 Then TrouveTypeSql = "#" & Format(TrouveTypeSql, "yyyy-mm-dd hh:mm") & "#": Exit Function
If IsDate(TrouveTypeSql) And InStr(TrouveTypeSql, "/") <> 0 Then TrouveTypeSql = "#" & Format(TrouveTypeSql, "yyyy-mm-dd") & "#": Exit Function
If IsNumeric(Replace(TrouveTypeSql, ",", ".")) Then TrouveTypeSql = Replace(TrouveTypeSql, ",", "."): Exit Function
If IsNumeric(Replace(TrouveTypeSql, ".", ",")) Then TrouveTypeSql = Replace(TrouveTypeSql, ",", "."): Exit Function
TrouveTypeSql = "'" & Replace(TrouveTypeSql, "'", "''") & "'"
End Function
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
Re @patricktoulon

Merci pour ta réponse Patrick, je ne me suis pas engagé dans un code complex, mais j'ai une piste pour la construction d'une regex
sur se fil il y a un dessin avec explication du cheminement du Pattern.

https://stackoverflow.com/questions/15491894/regex-to-validate-date-format-dd-mm-yyyy

Pour le reste il faux se lancer dans la construction du Pattern mais c'est un vrai sujet

Je m’arrête ici car c'est bien complexe mais si c'est un début d'idée pourquoi pas ? Enfin juste pour la compréhension du paterne le schéma est Top

est une librairie de Regex :
https://regexlib.com/Search.aspx?k=&c=5&m=5&ps=10

Je vais suivre merci @patricktoulon
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, patricktoulon, mapomme, laurent950, dysorthographie

Pour infos
Il y a dans les archives un long fil qui traite du sujet
De mémoire avec David84 ou jpn comme intervenant
Et il devait y avoir des bouts de RegExp dedans ;)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

V
  • Question
XL 2016 Convertir un format de date
Réponses
3
Affichages
435
vivi21
V
Ghassen
  • Question
XL 2019 Input.Box et format des dates mm/dd ou dd/mm
Réponses
6
Affichages
584
job75
job75
chaelie2015
  • Résolu(e)
XL 2013 (Résolu)Format date de Textebox vers cellule
Réponses
5
Affichages
431
Staple1600
Staple1600
T
  • Question
Microsoft 365 Ouvrir un fichier en fonction de sa date
Réponses
1
Affichages
135
sylvanu
sylvanu
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
216
fanch55
fanch55
J
  • Question
XL 2016 Pb macro qui plante toujours lors de la seconde exécution...
Réponses
3
Affichages
406
herve62
herve62
Chaton0408
  • Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
135
youky(BJ)
youky(BJ)
A
  • Question
XL 2016 Combobox Saisie Date
Réponses
12
Affichages
488
aurelio.ewane
A
pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
194
pompaero
pompaero
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U

Membres actuellement en ligne

3 membres et 40 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa