Autres projet fonction de reconnaissance format date

patricktoulon · 7 Décembre 2020

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

patricktoulon · 7 Décembre 2020

re
bon j'avance
la fonction doit retourner plusieur chose en fait

si oui ou non c'est une date
si il y a un timevalue
la date
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?

mapomme · 7 Décembre 2020

Surtout pour te saluer @patricktoulon et aussi un peu pour pinailler...

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 !

patricktoulon · 7 Décembre 2020

bonjour @mapomme
d'accords c'est du callfront alors

patricktoulon · 7 Décembre 2020

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

laurent950 · 7 Décembre 2020

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 ?

patricktoulon · 7 Décembre 2020

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

dysorthographie · 7 Décembre 2020

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

patricktoulon · 7 Décembre 2020

bonjour Robert
oui ca retourne une date formaté mais c'est le format que je veux surtout en retour
pas mal ton truc ca englobe pas tout mais c'est pas mal
pour commencer j'ajouterais la présence de 2":" pour le format avec heure minute sec

dysorthographie · 7 Décembre 2020

regarde ça existe

VB:

IsDate(TrouveType) And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <>

patricktoulon · 7 Décembre 2020

re
oui essai avec

VB:

Sub test()
MsgBox TrouveType("lundi 20/04/2020 20:50:35")
MsgBox TrouveType("lun. 20/04/2020 20:50:35")
End sub

ça rapproche le tout donc ca ne passe pas comme une date
teste ma fonction tu comprendra

laurent950 · 7 Décembre 2020

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

patricktoulon · 7 Décembre 2020

trouillard!!!!
je pense avoir trouver plus simple te toute façon c'était devant mes yeux

patricktoulon · 7 Décembre 2020

@Dudu2 m'a laissé tombé

Staple1600 · 8 Décembre 2020

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

Autres projet fonction de reconnaissance format date

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires