Extraire une date d'uns chaine en vba

loto · 11 Novembre 2010

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é · 11 Novembre 2010

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 :

Code:

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

Cordialement

loto · 11 Novembre 2010

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é · 11 Novembre 2010

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:

Code:

[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 · 11 Novembre 2010

Re : Extraire une date d'uns chaine en vba

Bonsoir Loto,Efgé ,le forum

un autre exemple que tu pourras arranger

cordialement

Banzai64 · 11 Novembre 2010

Re : Extraire une date d'uns chaine en vba

Bonsoir

Une solution (il me semble)

ROGER2327 · 11 Novembre 2010

Re : Extraire une date d'uns chaine en vba

Bonsoir à tous

Code:

[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 · 11 Novembre 2010

Re : Extraire une date d'uns chaine en vba

Roger et Banzai,

Vos solutions sont à garder précieusement

Super!!

Meric

JNP · 13 Novembre 2010

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

Code:

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

Code:

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 😎

Extraire une date d'uns chaine en vba

loto

XLDnaute Occasionnel

Pièces jointes

Efgé

XLDnaute Barbatruc

loto

XLDnaute Occasionnel

Efgé

XLDnaute Barbatruc

néné06

XLDnaute Accro

Banzai64

XLDnaute Accro

Pièces jointes

ROGER2327

XLDnaute Barbatruc

loto

XLDnaute Occasionnel

JNP

XLDnaute Barbatruc

Discussions similaires

Extraire une date d'uns chaine en vba

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency