Sub test()
Dim s$
s = "01/03/2011"
[A1] = s
MsgBox testDate([A1])
End Sub
Sub testII()
Dim s$
s = "01/03/2011"
[A1] = CDate(s)
[B1] = testDate([A1])
MsgBox [B1]
End Sub
Un petit souci
Code :
Sub test()
Dim s$
s = "01/03/2011"
[A1] = s
MsgBox testDate([A1])
End Sub
Code :
Sub testII()
Dim s$
s = "01/03/2011"
[A1] = CDate(s)
[B1] = testDate([A1])
MsgBox [B1]
End Sub
PS: Il se pourrait que le petit souci ne vienne pas de testdate
Function testDate(Cellule As Range) As String
'Application.Volatile
Dim oRexp, Match, Matches, MaDate As Date, MesMois, MesMoisBis, I As Integer, MaChaine As String, Jour As Long, An As Long
If Cellule = "" Then Exit Function
MesMois = Array("janvier", "janv.", "janv", "février", "févr.", "févr", "mars", "avril", "avr.", " avr ", "mai", "juin", _
"juillet", "juil.", "juil", "août", "septembre", "sept.", "sept", "octobre", "oct.", "oct", "novembre", "nov.", "nov", "décembre", "déc.", "déc")
MesMoisBis = Array("/01/", "/01/", "/01/", "/02/", "/02/", "/02/", "/03/", "/04/", "/04/", "/04/", "/05/", "/06/", "/07/", "/07/", "/07/", _
"/08/", "/09/", "/09/", "/09/", "/10/", "/10/", "/10/", "/11/", "/11/", "/11/", "/12/", "/12/", "/12/")
MaChaine = Cellule.Value
For I = LBound(MesMois) To UBound(MesMois)
If InStr(1, Cellule.Value, MesMois(I), vbTextCompare) > 0 Then
MaChaine = Trim(Replace(MaChaine, MesMois(I), MesMoisBis(I)))
MaChaine = Replace(Replace(MaChaine, " /", "/"), "/ ", "/")
Exit For
End If
Next I
Set oRexp = CreateObject("vbscript.regexp")
With oRexp
.Global = True
.Pattern = "(\b\d{1})(/\d{2}/\d{4})"
'Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, "0$1$2")
.Pattern = "(\b\s)(\d{1})(/\d{2}/)((?:0|1|2)[0-9])"
'Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, "0$2$320$4")
.Pattern = "(\b\s)(\d{1})(/\d{2}/)((?:3|4|5|6|7|8|9)[0-9])"
'Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, "$10$2$319$4")
.Pattern = "((0[1-9]|[12]\d|3[01])/(0[13578]|1[02])|(0[1-9]|[12]\d|30)/(0[469]|11))/(190[1-9]|19[1-9]\d|(20|21)\d\d)|(0[1-9]|[1]\d|[2][0-8])/02/(190[1-9]|19[1-9]\d|(20|21)\d\d)|29/02/((190|210)[48]|(19|20|21)([13579][26]|[2468][048])|200[048])"
'Set Matches = .Execute(MaChaine)
If .test(MaChaine) = True Then testDate = Right(MaChaine, 10) Else testDate = "Date non valide"
End With
End Function
If .Test(MaChaine) Then testDate = Right(MaChaine, 10) Else testDate = "Date non valide"
testDate = Switch(.Test(MaChaine), Right(MaChaine, 10), Not .Test(MaChaine), "Date non valide")
testDate = IIf(.Test(MaChaine), Right(MaChaine, 10), "Date non valide")
Function testDate2(Cellule As Range, Rang As Integer) As String
'Application.Volatile
Dim oRexp, Match, Matches, MaDate As Date, MesMois, MesMoisBis, I As Integer, MaChaine As String, Jour As Long, An As Long
If Cellule = "" Then Exit Function
MesMois = Array("janvier", "janv.", "janv", "février", "févr.", "févr", "mars", "avril", "avr.", " avr ", "mai", "juin", _
"juillet", "juil.", "juil", "août", "septembre", "sept.", "sept", "octobre", "oct.", "oct", "novembre", "nov.", "nov", "décembre", "déc.", "déc")
MesMoisBis = Array("/01/", "/01/", "/01/", "/02/", "/02/", "/02/", "/03/", "/04/", "/04/", "/04/", "/05/", "/06/", "/07/", "/07/", "/07/", _
"/08/", "/09/", "/09/", "/09/", "/10/", "/10/", "/10/", "/11/", "/11/", "/11/", "/12/", "/12/", "/12/")
MaChaine = Cellule.Value
For I = LBound(MesMois) To UBound(MesMois) 'traitement du mois
If InStr(1, Cellule.Value, MesMois(I), vbTextCompare) > 0 Then
MaChaine = Trim(Replace(MaChaine, MesMois(I), MesMoisBis(I)))
MaChaine = Replace(Replace(MaChaine, " /", "/"), "/ ", "/")
End If
Next I
Set oRexp = CreateObject("vbscript.regexp")
With oRexp
.Global = True
'traitement du jour
.Pattern = "(?:\s|\b)(\d{1})(/\d{2}/)(\d{2,4})(?:\s|\b)"
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " 0$1$2$3 ")
'traitement de l'année
.Pattern = "(?:\s|\b)(\d{1,2})(/\d{2}/)((?:0|1|2){1}[0-9])(?:\s|\b)" 'années 2000 à 2 chiffres
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " $1$220$3 ")
.Pattern = "(?:\s|\b)(\d{1,2})(/\d{2}/)((?:3|4|5|6|7|8|9){1}[0-9])(?:\s|\b)" 'années 1900 à 2 chiffres
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " $1$219$3 ")
.Pattern = "((0[1-9]|[12]\d|3[01])/(0[13578]|1[02])|(0[1-9]|[12]\d|30)/(0[469]|11))/((16|17|18|19|20|21)\d\d)|(0[1-9]|[1]\d|[2][0-8])/02/((16|17|18|19|20|21)\d\d)|29/02/((190|210)[48]|(16|17|18|19|20|21)([13579][26]|[2468][048])|200[048])"
If .test(MaChaine) = True Then
Set Matches = .Execute(MaChaine)
If Rang - 1 < Matches.Count Then testDate2 = Matches(Rang - 1) Else testDate2 = ""
Else
If Rang = 1 Then testDate2 = "Date non valide" Else testDate2 = ""
End If
End With
End Function
Juste pour le fun (et par curiosité), comment faire pour savoir quelle ligne est la plus gourmande ?
If .Test(MaChaine) Then testDate = Right(MaChaine, 10) Else testDate = "Date non valide"
testDate = Switch(.Test(MaChaine), Right(MaChaine, 10), Not .Test(MaChaine), "Date non valide")
testDate = IIf(.Test(MaChaine), Right(MaChaine, 10), "Date non valide")
on pourrait traiter les string de type francophone (jour mois année) dont les formats de chaîne de caractères sont utilisées dans ExcelIl faudrait qu'on essaie de lister un maximum de strings possibles, non ?
pas tant que cela je pense car déjà le jour (abc) n'est pas pris en compte dans le traitement.Déja combien de permutations possibles dans un string de ce genre?
abcJJ/MM/YY123
Si l'on s'en tient aux formats utilisés dans Excel, le problème principale me semble être le traitement de la partie mois (janvier, janv., janv-, 01,1,...).Est-ce possible d'estimer ce nombre ?
Function testDate2(Cellule As Range, Rang As Integer) As String
'Application.Volatile
Dim oRexp, Match, Matches, MesMois, MesMoisBis, I As Integer, MaChaine As String, Jour As Long, An As Long
If Cellule = "" Then Exit Function
MesMois = Array("janvier", "janv.", "janv", "février", "févr.", "févr", "mars", "avril", "avr.", "avr", "mai", "juin", _
"juillet", "juil.", "juil", "août", "septembre", "sept.", "sept", "octobre", "oct.", "oct", "novembre", "nov.", "nov", "décembre", "déc.", "déc")
MesMoisBis = Array("/01/", "/01/", "/01/", "/02/", "/02/", "/02/", "/03/", "/04/", "/04/", "/04/", "/05/", "/06/", "/07/", "/07/", "/07/", _
"/08/", "/09/", "/09/", "/09/", "/10/", "/10/", "/10/", "/11/", "/11/", "/11/", "/12/", "/12/", "/12/")
MaChaine = Cellule.Value
For I = LBound(MesMois) To UBound(MesMois) 'traitement du mois
If InStr(1, Cellule.Value, MesMois(I), vbTextCompare) > 0 Then
MaChaine = Trim(Replace(MaChaine, MesMois(I), MesMoisBis(I)))
MaChaine = Replace(Replace(MaChaine, " /", "/"), "/ ", "/")
End If
Next I
Set oRexp = CreateObject("vbscript.regexp")
With oRexp
.Global = True
'traitement du jour
.Pattern = "(?:\s|\b)(\d{1})(/\d{2}/)(\d{2,4})(?:\s|\b)"
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " 0$1$2$3 ")
'traitement de l'année
.Pattern = "(?:\s|\b)(\d{1,2})(/\d{2}/)((?:0|1|2){1}[0-9])(?:\s|\b)" 'années 2000 à 2 chiffres
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " $1$220$3 ")
.Pattern = "(?:\s|\b)(\d{1,2})(/\d{2}/)((?:3|4|5|6|7|8|9){1}[0-9])(?:\s|\b)" 'années 1900 à 2 chiffres
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " $1$219$3 ")
'le motif traite les dates des années 1600 à 2199
.Pattern = "((0[1-9]|[12]\d|3[01])/(0[13578]|1[02])|(0[1-9]|[12]\d|30)/(0[469]|11))/((16|17|18|19|20|21)\d\d)|(0[1-9]|[1]\d|[2][0-8])/02/((16|17|18|19|20|21)\d\d)|29/02/((17|18|19|21[0])[48]|(17|18|19|20|21)([13579][26]|[2468][048])|(160|200)[048])"
If .test(MaChaine) = True Then
Set Matches = .Execute(MaChaine)
If Rang - 1 < Matches.Count Then testDate2 = Matches(Rang - 1)
Else
If Rang = 1 Then testDate2 = "Date non valide"
End If
End With
End Function
Function testDate(Cellule As Range, Rang As Integer) As String
'Application.Volatile
Dim oRexp, Match, Matches, MesMois, MesMoisBis, I As Integer, MaChaine As String, Jour As Long, An As Long
If Cellule = "" Then Exit Function
MesMois = Array("janvier", "janv.", "janv", "février", "févr.", "févr", "fevrier", "fevr.", "fevr", _
"mars", "avril", "avr.", " avr ", "mai", "juin", _
"juillet", "juil.", "juil", "août", "aout", "septembre", "sept.", _
"sept", "octobre", "oct.", "oct", "novembre", "nov.", "nov", "décembre", "déc.", "déc", "decembre", "dec.", "dec")
MesMoisBis = Array("/01/", "/01/", "/01/", "/02/", "/02/", "/02/", "/02/", "/02/", "/02/", _
"/03/", "/04/", "/04/", "/04/", "/05/", _
"/06/", "/07/", "/07/", "/07/", "/08/", "/08/", "/09/", "/09/", _
"/09/", "/10/", "/10/", "/10/", "/11/", "/11/", "/11/", "/12/", "/12/", "/12/", "/12/", "/12/", "/12/")
MaChaine = LCase(Cellule.Value)
For I = LBound(MesMois) To UBound(MesMois) 'traitement du mois
If InStr(1, Cellule.Value, MesMois(I), vbTextCompare) > 0 Then
MaChaine = Trim(Replace(MaChaine, MesMois(I), MesMoisBis(I)))
MaChaine = Replace(Replace(MaChaine, " /", "/"), "/ ", "/")
End If
Next I
Set oRexp = CreateObject("vbscript.regexp")
With oRexp
.Global = True
.IgnoreCase = True
'traitement du jour
.Pattern = "(?:\s|\b)(\d{1})([ /-]\d{1,2}[ /-])(\d{2,4})(?:\s|\b)"
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " 0$1$2$3 ")
'traitement de l'année
.Pattern = "(?:\s|\b)(\d{1,2})([ /-]\d{1,2}[ /-])((?:0|1|2){1}[0-9])(?:\s|\b)" 'années 2000 à 2 chiffres
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " $1$220$3 ")
.Pattern = "(?:\s|\b)(\d{1,2})([ /-]\d{1,2}[ /-])((?:3|4|5|6|7|8|9){1}[0-9])(?:\s|\b)" 'années 1900 à 2 chiffres
Set Matches = .Execute(MaChaine)
MaChaine = .Replace(MaChaine, " $1$219$3 ")
.Pattern = "((0[1-9]|[12]\d|3[01])[ /-](0?[13578]|1[02])|(0[1-9]|[12]\d|30)[ /-](0?[469]|11))[ /-]((16|17|18|19|20|21)\d\d)|(0[1-9]|[1]\d|[2][0-8])[ /-]0?2[ /-]((16|17|18|19|20|21)\d\d)|29[ /-]0?2[ /-]((190|210)[48]|(17|18|19|20|21)([13579][26]|[2468][048])|(160|200)[048])"
If .test(MaChaine) = True Then
Set Matches = .Execute(MaChaine)
If Rang - 1 < Matches.Count Then testDate = Format(Matches(Rang - 1), "dd/mm/yyyy")
Else
If Rang = 1 Then testDate = "Date non valide"
End If
End With
End Function
Function ADADATE(ByVal s$) As Variant
Const MOIS As String = _
"(janv(ier)?|févr(ier)?|mar(s)?|avr(il)?|mai?|juin?|juil(let)?|août?|sept(embre)?|oct(obre)?|nov(embre)?|déc(embre)?)"
Dim Matches
With CreateObject("VBScript.RegExp")
.Global = -1: .IgnoreCase = -1
.Pattern = "^((0[1-9]|[12]\d|3[01])\/(0[13578]|1[02])\/((19|[2-9]\d)\d{2}))|((MOIS)\d{1,2}(,?\s*\d{4})?)|(\d{1,2}[- ]*(" & MOIS & ")([- ]*\d{2,4})?)\b"
Set Matches = .Execute(s)
End With
ADADATE = vbNullString
If Matches.Count > 0 Then ADADATE = CDate(Matches.Item(0).Value)
End Function
Sub aTest()
Dim tDates, i As Byte, test$, a$, b$
With Application
Randomize 2012111
.ScreenUpdating = False
For i = 0 To 11
a = i + 1 & ". " & .Rept(Chr(65 + Int((Rnd * 26) + 1)), Int((Rnd * 5) + 1)) & Format(Date + (i * Int((Rnd * 240) + 1)), IIf(i Mod 2 = 0, "dddd d mmm yyyy", "d mmmm yy")) & .Rept(Chr(65 + Int((Rnd * 26) + 1)), Int((Rnd * 6) + 1))
b = b & a & vbCrLf
test = test & i + 1 & ". " & ADADATE(a) & vbCrLf
Next i
End With
MsgBox b, vbInformation, "STRINGS": MsgBox test, vbExclamation, "DATES"
End Sub
"(0[1-9]|[12]\d|30)[ /-](0?[469]|11))[ /-]((16|17|18|19|20|21)\d\d)|(0[1-9]|[1]\d|[2][0-8])[ /-]0?2[ /-]((16|17|18|19|20|21)\d\d)|29[ /-]0?2[ /-]((190|210)[48]|(17|18|19|20|21)([13579][26]|[2468][048])|(160|200)[048])"[COLOR=#800000]
[/COLOR]
Pour le reste, procède par nouveau motif pour ramener les autres types recherchés. Tu pourras ensuite les mettre bout à bout..Pattern = "(0[1-9]|[12]\d|3[01])[ /](" & MOIS & ")[ /](\d{2,4})"
Function ADADATE(ByVal s$) As Variant
Const MOIS As String = _
"(janv(ier)?|févr(ier)?|mar(s)?|avr(il)?|mai?|juin ?|juil(let)?|août?|sept(embre)?|oct(obre)?|nov(embre)?|déc(embre)?)"
Dim Matches
With CreateObject("VBScript.RegExp")
.Global = -1: .IgnoreCase = -1
.Pattern = "(0?[1-9]|[12]\d|3[01])[ /](" & MOIS & ")[ /](\d{2,4})"
Set Matches = .Execute(s)
End With
ADADATE = vbNullString
If Matches.Count > 0 Then ADADATE = CDate(Matches.Item(0).Value)
End Function
[FONT=monospace][/FONT]
pour que le motif puisse trouver les dates de ce mois, donc :nov(emb re)?
Const MOIS As String = _
"(janv(ier)?|févr(ier)?|mar(s)?|avr(il)?|mai?|juin ?|juil(let)?|août?|sept(embre)?|oct(obre)?|nov(embre)?|déc(embre)?)"
)
- modification dans le motif afin que les dates entrées avec un seul digit en jour (9.Xz9 juillet 2013+²4) soient prises en compte par le motif :
Code:.Pattern = "(0?[1-9]|[12]\d|3[01])[ /](" & MOIS & ")[ /](\d{2,4})"
J'ai enlevé le \w car il ne sert pas dans ton exemple actuel.
A+
'le motif traite les dates des années 1600 à 2199
.Pattern = "((0[1-9]|[12]\d|3[01])/(0[13578]|1[02])|(0[1-9]|[12]\d|30)/(0[469]|11))/((16|17|18|19|20|21)\d\d)|(0[1-9]|[1]\d|[2][0-8])/02/((16|17|18|19|20|21)\d\d)|29/02/((17|18|19|21[0])[48]|(17|18|19|20|21)([13579][26]|[2468][048])|(160|200)[048])"