Option Explicit
Function ExtraireDate(Rng As Range) As String
Dim Matches As Object
Dim Match As Object
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
Dim CherchePattern(1 To 2) As Variant
' Stock Pattern dans une variable Tableau
' Aux Choix de la construction du pattern dans la case du tableau
CherchePattern(1) = "\b\d{4}\b|d{4}"
CherchePattern(2) = "(\d{4})" ' "(^|\D)(\d{4})(\D|$)"
' Exemple ici c'est la case 2 du tableau
' Alors l'indice sera la case du tableau
Dim N As Integer
N = 2
Dim i As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set Rng = Rng.Cells(1, 1)
' Recherche en Ligne :
' ---------------------
reg.Pattern = CherchePattern(N) ' l'indice N sera = a la case du tableau.
reg.MultiLine = True: reg.IgnoreCase = False: reg.Global = True: Debug.Print reg.test(Rng.Text)
Set Matches = reg.Execute(Rng.Text)
' Cible de la recherche (Partie du Mots ou chaine recherché !)
For Each Match In Matches
'Debug.Print "source >>", Match.Value
' For i = 0 To Match.SubMatches.Count - 1
' Debug.Print "[$" & i + 1 & "]", Match.SubMatches(i)
' Next i
ExtraireDate = Match.Value
Exit For
Next Match
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' libération d'objets
Set Matches = Nothing
Set Match = Nothing
Set reg = Nothing
End Function
