Extraire une date d'uns chaine en vba

[loto]

Salut à vous,

Je cherche à extraire une date au format jj/mm/aaaa d'une chaine de caractère qui contient du texte (voyez l'exemple)

J'y arrive très bien - un peu artisanalement peut-être- par un calcul mais il faut que je l'écrire proprement en vba (avec une référance à un range). Il faudrait peut -être:

-soit extraire tout simplement ce qui constitue la date (au format jj/mm/aaaa)
-soit en écrivant ma formule gauche/droite/longeur

Pouvez-vous m'aider à écrire un truc propre en vba SVP?

Merci

 

[Efgé]

Re : Extraire une date d'uns chaine en vba

Bonjour loto,
Si la structure de la chaine de caractère est toujours la même :

Sheets("Feuil1").Range("A3") = Mid(Sheets("Feuil1").Range("A1").Value, 10, 10)

Cordialement

 

[loto]

Re : Extraire une date d'uns chaine en vba

Salut,

Merci pour ce mid que je ne connaissais pas et qui m'arrange bien ce soir...

Il se pourrait par contre, qu'effectivement, les infos ne soient pas systématiquement formatées ainsi...
C'est pourquoi, j'aurais bien aimé extraire juste ce qui est une "date"...

mais enfin, tu me relances et je te remercie!!

 

[Efgé]

Re : Extraire une date d'uns chaine en vba

Re
Si la date est la première valeure numérique de la chaine, tu peux essayer ceci:

[COLOR=blue]Sub[/COLOR] Test2()
[COLOR=blue]With[/COLOR] Sheets("Feuil1").Range("A1")
    [COLOR=blue]For[/COLOR] i = 1 [COLOR=blue]To[/COLOR] Len(.Value)
        [COLOR=blue]If[/COLOR] IsDate(Mid(.Value, i, 10)) [COLOR=blue]Then[/COLOR]
            Sheets("Feuil1").Range("A3") = Mid(.Value, i, 10)
            [COLOR=blue]Exit For[/COLOR]
        [COLOR=blue]End If[/COLOR]
    [COLOR=blue]Next[/COLOR] i
[COLOR=blue]End With[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Cordialement

EDIT Utilisation du With

 

[néné06]

Re : Extraire une date d'uns chaine en vba

Bonsoir Loto,Efgé ,le forum

un autre exemple que tu pourras arranger

cordialement

 

[Banzai64]

Re : Extraire une date d'uns chaine en vba

Bonsoir

Une solution (il me semble)

 

[ROGER2327]

Re : Extraire une date d'uns chaine en vba

Bonsoir à tous

[B][COLOR=DarkSlateGray]Function dat(r)
Dim i, x
  dat = ""
  If r.Value Like "*##/##/####*" Or r.Value Like "*##/#/####*" Then
    x = Split(r.Value, "/")
    For i = 0 To UBound(x) - 2
      If IsNumeric(Right$(x(i), 2)) And IsNumeric(x(i + 1)) And IsNumeric(Left$(x(i + 2), 4)) Then Exit For
    Next i
    dat = DateSerial(Left$(x(i + 2), 4), x(i + 1), Right$(x(i), 2))
  ElseIf r.Value Like "*#/##/####*" Or r.Value Like "*#/#/####*" Then
    x = Split(r.Value, "/")
    For i = 0 To UBound(x) - 2
      If IsNumeric(Right$(x(i), 1)) And IsNumeric(x(i + 1)) And IsNumeric(Left$(x(i + 2), 4)) Then Exit For
    Next i
    dat = DateSerial(Left$(x(i + 2), 4), x(i + 1), Right$(x(i), 1))
  End If
End Function

Sub ExtraitDateADroite()
Dim r As Range
  With Selection [COLOR=DarkOrange]'plage à adapter[/COLOR]
    For Each r In .Cells
      r.Offset(0, 1).Value = dat(r)
    Next r
  End With
End Sub

Sub RemplaceParDate()
Dim r As Range
  With Selection [COLOR=DarkOrange]'plage à adapter[/COLOR]
    For Each r In .Cells
      r.Value = dat(r)
    Next r
  End With
End Sub[/COLOR][/B]

La fonction dat() prend une cellule pour argument et renvoie la première date trouvée dans le contenu de cette cellule.

La procédure ExtraitDateADroite s'applique à la plage de cellules sélectionnées et renvoie la première date trouvée dans le contenu de chaque cellule à droite de celle-ci.

La procédure RemplaceParDate s'applique à la plage de cellules sélectionnées et renvoie la première date trouvée dans le contenu de chaque cellule dans cette même cellule. (Par conséquent, les données initiales sont perdues et remplacées par les dates trouvées s'il y en a.)
​

ROGER2327
#4519

Lundi 9 As 138 (Equarrissage pour tous, V)
21 Brumaire An CCXIX
2010-W45-4T21:01:28Z

 

[loto]

Re : Extraire une date d'uns chaine en vba

Roger et Banzai,

Vos solutions sont à garder précieusement

Super!!

Meric

 

[JNP]

Re : Extraire une date d'uns chaine en vba

Bonjour le fil ,
Un peu en retard pour la bataille ...
2 solutions avec RegExp
Une donnant un résultat Texte

Function ExtractionDate(Texte As String) As String
Application.Volatile
Dim Matches
With CreateObject("vbscript.regexp")
    .Global = False
    .Pattern = "\d{1,2}\/\d{1,2}\/\d{2,4}"
    Set Matches = .Execute(Texte)
    If Matches.Count = 1 Then
    ExtractionDate = CDate(Matches(0))
    Else
    ExtractionDate = ""
    End If
End With
End Function

et une donnant une résolution en date

Function ExtractionDate(Texte As String) As Date
Application.Volatile
Dim Matches
With CreateObject("vbscript.regexp")
    .Global = False
    .Pattern = "\d{1,2}\/\d{1,2}\/\d{2,4}"
    Set Matches = .Execute(Texte)
    If Matches.Count = 1 Then
    ExtractionDate = CDate(Matches(0))
    Else
    ExtractionDate = 0
    End If
End With
End Function

celle-ci renvoyant 00/01/1900 si pas de date dans le texte.
Bon WE