Expressions régulières - Patterns pour RegExp

Function DateLettreEnNbre(Cellule As Range) As String 'David84 http://www.excel-downloads.com/forum/148188-expressions-regulieres-patterns-pour-regexp-11.html#post1092727
Dim oRegExp, Match, Matches, Mois, Unités, Dizaines, Dizaine, Centaines, Milliers, i As Integer, MaChaine As String, ChaineInit As String, _
MonPattern As String, j As Byte, Item, jour, an, testUnit As Boolean, testMill As Boolean, testCent As Boolean, testDiz As Boolean, testDizs As Boolean, _
temp1 As Byte, temp2 As Byte, temp3 As Byte, temp4 As Byte, temp5 As Byte, antemp

If Cellule = "" Then Exit Function
MaChaine = LCase(Cellule.Value)
MaChaine = Replace(Replace(" " & MaChaine & " ", "premier", "un"), " mil ", " mille ")
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
    .Global = True
    .IgnoreCase = True
    
Unités = Array("un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
Dizaine = Array("onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", "dix huit", "dix neuf")
Dizaines = Array("dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante dix", "quatre vingt", "quatre vingt dix")
Mois = Array(" janvier ", " février ", " mars ", " avril ", " mai ", " juin ", " juillet ", " août ", " septembre ", " octobre ", " novembre ", " décembre ")
Centaines = Array("cent", "deux cent", "trois cent", "quatre cent", "cinq cent", "six cent", "sept cent", "huit cent", "neuf cent")
Milliers = Array("mille", "deux mille")

'traitement du mois
For i = LBound(Mois) To UBound(Mois)
    .Pattern = Mois(i)
        Set Matches = .Execute(MaChaine)
        If .Test(MaChaine) = True Then
            For j = 0 To Matches.Count - 1
                MaChaine = Replace(MaChaine, Matches.Item(j), " /" & Format(i + 1, "00") & "/ ")
            Next j
        End If
Next i

MaChaine = Replace(Replace(MaChaine, "-", " "), " et ", " ")
ChaineInit = MaChaine

'Traitement du jour
testDiz = False And testDizs = False And testUnit = False
jour = Left(MaChaine, InStr(1, MaChaine, "/") - 1)

For i = UBound(Dizaine) To LBound(Dizaine) Step -1
    .Pattern = Dizaine(i)
        Set Matches = .Execute(jour)
        If .Test(jour) = True Then
            For j = 0 To Matches.Count - 1
                temp1 = i + 11: testDiz = True
            Next j
        End If
        If testDiz = True Then Exit For
Next i

If testDiz = False Then
    For i = UBound(Dizaines) To LBound(Dizaines) Step -1
        .Pattern = Dizaines(i)
            Set Matches = .Execute(jour)
            If .Test(jour) = True Then
                For j = 0 To Matches.Count - 1
                    temp2 = (i + 1) * 10: testDizs = True
                Next j
            End If
            If testDizs = True Then Exit For
    Next i

    For i = UBound(Unités) To LBound(Unités) Step -1
        .Pattern = Unités(i)
            Set Matches = .Execute(jour)
            If .Test(jour) = True Then
                For j = 0 To Matches.Count - 1
                    temp3 = i + 1: testUnit = True
                Next j
            End If
            If testUnit = True Then Exit For
    Next i
End If
If testDiz = False And testDizs = False And testUnit = True Then MaChaine = Replace(MaChaine, jour, temp3, , 1): GoTo TraitementAnnée
If testDiz = True And testDizs = False And testUnit = False Then MaChaine = Replace(MaChaine, jour, temp1, , 1): GoTo TraitementAnnée
If testDiz = False And testDizs = True And testUnit = False Then MaChaine = Replace(MaChaine, jour, temp2, , 1): GoTo TraitementAnnée
If testDiz = False And testDizs = True And testUnit = True Then MaChaine = Replace(MaChaine, jour, Left(temp2, 1) & temp3, , 1): GoTo TraitementAnnée

'traitement de l'année
TraitementAnnée:
testMill = False
testCent = False
testDiz = False
testDizs = False
testUnit = False
temp1 = 0
temp2 = 0
temp3 = 0
temp4 = 0
temp5 = 0
an = Trim(Right(MaChaine, Len(MaChaine) - InStrRev(MaChaine, "/")))
antemp = an


For i = UBound(Milliers) To LBound(Milliers) Step -1
    .Pattern = Milliers(i)
        Set Matches = .Execute(antemp)
        If .Test(antemp) = True Then
            For j = 0 To Matches.Count - 1
                temp1 = i + 1: testMill = True
                antemp = Trim(Replace(antemp, Milliers(i), ""))
            Next j
        End If
        If testMill = True Then Exit For
Next i

For i = UBound(Centaines) To LBound(Centaines) Step -1
    .Pattern = Centaines(i)
        Set Matches = .Execute(antemp)
        If .Test(antemp) = True Then
            For j = 0 To Matches.Count - 1
                temp2 = i + 1: testCent = True
                antemp = Trim(Replace(antemp, Centaines(i), ""))
            Next j
        End If
        If testCent = True Then Exit For
Next i

For i = LBound(Dizaine) To UBound(Dizaine)
    .Pattern = Dizaine(i)
        Set Matches = .Execute(antemp)
        If .Test(antemp) = True Then
            For j = 0 To Matches.Count - 1
                temp4 = i + 11: testDiz = True
                antemp = Trim(Replace(antemp, Dizaine(i), ""))
            Next j
        End If
        If testDiz = True Then Exit For
Next i

For i = UBound(Dizaines) To LBound(Dizaines) Step -1
    .Pattern = Dizaines(i)
        Set Matches = .Execute(antemp)
        If .Test(antemp) = True Then
            For j = 0 To Matches.Count - 1
                temp3 = i + 1: testDizs = True
                antemp = Trim(Replace(antemp, Dizaines(i), ""))
            Next j
        End If
        If testDizs = True Then Exit For
Next i

For i = LBound(Unités) To UBound(Unités)
    .Pattern = Unités(i)
        Set Matches = .Execute(antemp)
        If .Test(antemp) = True Then
            For j = 0 To Matches.Count - 1
                temp5 = i + 1: testUnit = True
                antemp = Trim(Replace(antemp, Unités(i), ""))
            Next j
        End If
        If testUnit = True Then Exit For
Next i

If testMill = True And testCent = True And testDiz = False And testDizs = False And testUnit = True Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & 0 & temp5): GoTo Fin
If testMill = True And testCent = True And testDiz = True And testDizs = False And testUnit = True Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & 0 & temp5): GoTo Fin
If testMill = True And testCent = True And testDiz = False And testDizs = False And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & 0 & 0): GoTo Fin
If testMill = True And testCent = True And testDiz = False And testDizs = True And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 & temp4): GoTo Fin
If testMill = True And testCent = True And testDiz = True And testDizs = False And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp4): GoTo Fin
If testMill = True And testCent = True And testDiz = False And testDizs = True And testUnit = True Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 & temp5): GoTo Fin 'vingt et un et ...
If testMill = True And testCent = True And testDiz = True And testDizs = True And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 + Left(temp4, 1) & Right(temp4, 1)): GoTo Fin 'soixante et onze ...
If testMill = True And testCent = False And testDiz = False And testDizs = False And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 & temp4): GoTo Fin 'deux mille ...
If testMill = True And testCent = False And testDiz = False And testDizs = False And testUnit = True Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 & temp5): GoTo Fin 'deux mille un...
If testMill = True And testCent = False And testDiz = False And testDizs = True And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 & temp4): GoTo Fin 'deux mille dix...
If testMill = True And testCent = False And testDiz = True And testDizs = False And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp4): GoTo Fin 'deux mille onze...
If testMill = True And testCent = False And testDiz = False And testDizs = True And testUnit = True Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 & temp5): GoTo Fin 'deux mille ving et un...
If testMill = True And testCent = False And testDiz = True And testDizs = True And testUnit = False Then MaChaine = Replace(MaChaine, an, temp1 & temp2 & temp3 + Left(temp4, 1) & Right(temp4, 1)): GoTo Fin 'deux mille soixante et onze...

Fin:
MaChaine = Trim(Replace(MaChaine, " ", ""))
If Len(MaChaine) = 9 Then MaChaine = 0 & MaChaine
.Pattern = "((0?[1-9]|[12]\d|3[01])[ /-](0?[13578]|1[02])|(0[1-9]|[12]\d|30)[ /-](0?[469]|11))[ /-]((1\d|2\d)\d\d)|(0[1-9]|1\d|2[0-8])[ /-]0?2[ /-]((1\d|2\d)\d\d)|29[ /-]0?2[ /-]((1[01345789]|2[1235679])0[48]|(1\d|2\d)([13579][26]|[2468][048])|(1[2604]|28)0[048])" '1000 à 2999

If .Test(MaChaine) = True Then DateLettreEnNbre = Format(MaChaine, "dd/mm/yyyy") Else DateLettreEnNbre = "Date non valide"

Set oRegExp = Nothing
Set Matches = Nothing
Set Item = Nothing
End With

End Function