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 · 8 Décembre 2020

Bonjour Staple
j'ai bien trouvé la fonction de david 84

Date formatée à partir d'une chaîne de caractères alphabétiques ou numériques

Bonjour, pour mes 4000 messages, je vous ai préparé une petite fonction capable de ramener une chaîne de caractères de type date au format choisi. La chaîne de caractères à traiter peut être de type alphabétique ou numérique : - trois mars mille neuf cent soixante cinq - 3 mars mille...

www.excel-downloads.com

mais ca n'est pas ce que je cherche a faire
je donne une date avec un format quelconque(accepté et reconnu par excel) et je veux récupérer la chaine string du format
pour récupérer la date dans les chaine 2 lignes me suffisent qu'il y est l'heure ou pas

VB:

Sub test()
dat = "lun. 2020/avril/12 20:52:15"
t = Split(dat, " ")
If Not IsNumeric(t(0)) Then madate = CDate(t(1)) Else madate = CDate(t0)
MsgBox madate
End Sub

sur tout que la il est question de format accepté par excel car c'est comme je l'ai dit pour traiter un retour de req Ado
donc dans ce contexte je n'ai pas d'autre choix que de passer les formats(accepté et reconnu par excel) en revue
j'ai bien tenté dans un tableau mais par exemple ici madate = CDate(t0) me renvoie au format francais il est donc pas possible d'envisager disséquer la chaine pour en retirer la date en gardant le même format sauf usine a gaz bien sur des formats accepté par excel il y en a pas tant que ca

Staple1600 · 8 Décembre 2020

Bonjour le fil

=>patricktoulon
Une astuce de derrière les fagots
(à exploiter ou pas)
Quoique il se passe des choses bizarres...
Voir test ci-dessous

VB:

Sub A_Explorer_Ou_Pas()
Dim Kz$, Kzz$
[A1] = Date
Kz = Range("A1").Value(11)
MsgBox Split(Split(Kz, "DateTime")(1), "/")(0)
[A1] = Time
Kzz = Range("A1").Value(11)
MsgBox Split(Split(Kzz, "DateTime")(1), "/")(0), vbCritical, "Arghhhh!"
End Sub

patricktoulon · 8 Décembre 2020

re
Bonsoir @Staple1600
je connais le range(xy).value(xlRangeValueXMLSpreadsheet)
mais je vois pas trop d'exploitation possible dans mon contexte

non ma fonction c'est amélioré j'ai besoin de 2 choses
faire la difference entre
dim. 20/12/2020(l'espace)
dim.20/12/2020(pas d'espace)

mes if ne sont pas bien au points

et la 2d choses et de déterminer le séparateur date dans la chaîne
pour réduire a 1 seule case paragraphe par format

VB:

Sub test2()
    Dim a, forme$, x As Boolean, dat As Date, T$, AA$, timeval
    'a = "20-mars-2020 20:52:32"
    'a = "dimanche 20-décembre-2020 20:52:32"
    'a = "dimanche 20-décembre-2020 20:52"
    a = "dim. 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"
    'a = "2020/03/20"
    AA = a
    x = GetDateFormat(a, dat, timeval, forme)
    If x = True Then
        T = AA & vbCrLf & "-----------------------" & vbCrLf
        T = T & "est une date : " & CStr(x) & vbCrLf
        T = T & "date : " & DateValue(a) & vbCrLf
        T = T & "time value : " & timeval & vbCrLf
        T = T & "format :" & forme & vbCrLf
        T = T & vbCrLf & "------------------------" & vbCrLf
        T = T & "controle par re conversion" & vbCrLf
        T = T & Format(DateValue(dat) + timeval, forme)
        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, 4)) And Not Left(a, 4) Like "*.*" 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

MsgBox TimeValue(a)



        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 = ""


        Case Format(a, "yyyy/mm/dd") = a: forme = "yyyy/mm/dd": a = DateValue(a): ddd = ""
        Case Format(a, "yyyy mm dd") = a: forme = "yyyy mm dd": a = DateValue(a): ddd = ""
        Case Format(a, "yyyy.mm.dd") = a: forme = "yyyy.mm.dd": a = DateValue(a): ddd = ""
        Case Format(a, "yyyy-mm-dd") = a: forme = "yyyy-mm-dd": 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
           If Len(ddd) > 4 Then ddd = "dddd "
        dat = a
        forme = ddd & forme
        GetDateFormat = IsDate(a)
    End If
End Function

Staple1600 · 8 Décembre 2020

Re

=>patricktoulon
Toi, oui
Mais il n'y a pas que toi qui lis ton fil
Nous sommes potentiellement plus de 147000 à pouvoir le faire.

patricktoulon · 8 Décembre 2020

re
oui si tu veux
disons que j'aimerais résoudre mon problème
là dans le contexte de ma demande le rapport avec return type xml n'est que très lointain

je me sert de cette méthode pour récupérer le format html de valeurs inscrites dans les cellules avec texte de différents format (moyennant quelque suppression de terme dans la chaîne obtenue )
si tout dans un seul format ->récupérer le style css dans les balises style
si portion de texte différents format ->récupérer le html dans les balises "cell" et netoyage des attributs shema
c'est assez pratique oui

tu a une solution pour mes deux petit besoins ?

Staple1600 · 8 Décembre 2020

Re

=>patricktoulon
Personnellement, je pense que cela doit déjà exister quelque part, non?
Que cette problématique a déjà du être "rapportée" à la sphère ADO.
En qu'en général, le traitement des dates en informatique a du être vu en long et en large (voir les normes ISO)
Je ne doute pas que tu finiras pas trouvé une solution soit
1) dans tes archives
2) avec tes neurones de 2020
3) avec l'aide des petits gars et filles d'XLD.

patricktoulon · 8 Décembre 2020

oui je trouverais
là je suis un peu dispersé je travaille sur 3 fichiers le mien et celui de 2 membres 3 sujet différents
quand je bloque je fait comme ça ,je travaille sur un autre projet pour rincer les neurones grisées

patricktoulon · 9 Décembre 2020

bon j'ai avancé
j'ai réduit la sequence de if a une seule ligne pour chopper le jour en lettre (abrégé ou pas)

j'ai ajouter une toute petite boucle de recherche du séparateur date
ce qui a pour effet de pouvoir réduire chaque paragraphe a une seule ligne
j'ai ajouter dans la sub la reconversion pour voir si le formatage (avec la chaine de format obtenu) de la date revenait a l'initiale

la fonction retourne la date entiere(avec time value)
j'ai donc la date,l'heure,le string format

VB:

Option Explicit
Sub test2()
    Dim a, forme$, x As Boolean, dat As Date, T$, AA$, timeval
    'a = "20-mars-2020 20:52:32"
    'a = "dimanche 20-décembre-2020 20:52:32"
    a = "dimanche 20-décembre-2020 20:52"
    'a = "dim. 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"
    'a = "2020/03/20"
    AA = a
    x = GetDateFormat(a, dat, timeval, forme)
    If x = True Then
        T = AA & vbCrLf & "-----------------------" & vbCrLf
        T = T & "est une date : " & CStr(x) & vbCrLf
        T = T & "date : " & DateValue(a) & vbCrLf
        T = T & "time value : " & timeval & vbCrLf
        T = T & "format :" & forme & vbCrLf
        T = T & vbCrLf & "------------------------" & vbCrLf
        T = T & "controle par re conversion" & vbCrLf
        T = T & Format(DateValue(dat) + timeval, forme)
        MsgBox T
    Else
    End If
End Sub

Function GetDateFormat(a, dat, timeval, forme)
    Dim ddd$, b$, i&, sep$
    forme = ""
    If Not IsDate(a) Then    'si jour en lettre(abrégé ou complet)

        If Not IsNumeric(Left(a, 5)) Then
            If InStr(Left(a, 4), ".") > 0 Or InStr(Left(a, 5), ". ") > 0 Or Mid(a, 4, 1) = " " Then ddd = "ddd ": b = Trim(Mid(a, 5)) Else ddd = "dddd ": b = Mid(a, InStr(1, a, " ") + 1)
        End If
        If b <> "" Then a = b
    End If
    If IsDate(a) Then
        For i = 1 To 5    '
            If InStr("/,.- ", Mid(a, i, 1)) > 0 Then sep = Mid(a, i, 1): Exit For
        Next

        Select Case True
            'test format jour mois en lettre complet année
        Case Format(a, "dd" & sep & "mmmm" & sep & "yyyy") = a: a = CDate(a): forme = "dd" & sep & "mmmm" & sep & " yyyy"

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

            'test format jour mois en lettre complet année heure minute
        Case Format(a, "dd" & sep & "mmmm" & sep & "yyyy hh:nn") = a: forme = "dd" & sep & "mmmm" & sep & "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" & sep & "mmmm" & sep & "yyyy hh:nn:ss") = a: forme = "dd" & sep & "mmmm" & sep & "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" & sep & "mmm" & sep & "yyyy hh:nn") = a: forme = "dd" & sep & "mmm" & sep & "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" & sep & "mmm" & sep & "yyyy hh:nn:ss") = a: forme = "dd" & sep & "mmm" & sep & "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" & sep & "mm" & sep & "yyyy hh:nn") = a: forme = "dd" & sep & "mm" & sep & "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" & sep & "mm" & sep & "yyyy hh:nn:ss") = a: forme = "dd" & sep & "mm" & sep & "yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a): timeval = TimeValue(a)

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

        Case Format(a, "yyyy" & sep & "mm" & sep & "dd") = a: forme = "yyyy" & sep & "mm" & sep & "dd": a = DateValue(a): ddd = ""

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

        End Select
        If Len(ddd) > 5 Then ddd = "dddd "
        dat = a
        forme = ddd & forme
        GetDateFormat = IsDate(a)
    End If
End Function

Autres projet fonction de reconnaissance format date

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Date formatée à partir d'une chaîne de caractères alphabétiques ou numériques

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires