Autres projet fonction de reconnaissance format date

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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
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
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 !
 
Dernière édition:
Vote positif 0 Vote négatif
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
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
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
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
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
565
vgendron
vgendron
D
  • Question Question
Microsoft 365 Code VBA pour date DD/MM/YYYY
Réponses
6
Affichages
428
Staple1600
Staple1600
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
696
TooFatBoy
TooFatBoy
xhudi69
  • Question Question
XL 2021 Sélection de mails OutLook pour traitements
Réponses
0
Affichages
330
xhudi69
xhudi69
N
  • Résolu(e)
Microsoft 365 Format date d'une textbox vers une cellule
Réponses
8
Affichages
725
ChTi160
ChTi160
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
668
arnoldbrice19
A
S
  • Résolu(e)
XL 2019 Problème de remplissage cellule en vba
Réponses
5
Affichages
488
snoopy07
S
M
  • Question Question
XL 2010 Demande de quantité d'un produit dans un magasin spécifique selon la date la plus ancienne
2
Réponses
21
Affichages
2 K
Mody200
M
PORCHER
  • Question Question
Microsoft 365 Incompatibilité de type
Réponses
1
Affichages
413
Dranreb
Dranreb
T
  • Résolu(e)
XL 2021 Incompatibilité de type avec un userform
2
Réponses
19
Affichages
983
Bernard38
Bernard38
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
665
Phil69970
Phil69970
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
1 K
telemarrk
T
V
  • Question Question
XL 2016 Convertir un format de date
Réponses
3
Affichages
762
vivi21
V
petitbuzuc
  • Question Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
764
fanch55
fanch55
T
  • Question Question
Microsoft 365 Ouvrir un fichier en fonction de sa date
Réponses
1
Affichages
454
sylvanu
sylvanu
chaelie2015
  • Résolu(e)
XL 2013 (Résolu)Format date de Textebox vers cellule
Réponses
5
Affichages
803
Staple1600
Staple1600
Ghassen
  • Question Question
XL 2019 Input.Box et format des dates mm/dd ou dd/mm
Réponses
6
Affichages
1 K
job75
job75
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
J
  • Question Question
XL 2016 Pb macro qui plante toujours lors de la seconde exécution...
Réponses
3
Affichages
669
herve62
herve62
Chaton0408
  • Question Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
617
youky(BJ)
youky(BJ)
Retour