Parcourir une chaîne de caractères pour récupérer une date en particulier

Bonjour à tous,
J'aimerais solliciter votre aide pour une macro.

L'objectif de cette macro est de remplacer le contenu de chaque cellule de la colonne H "Commentaires internes agrégés" par seulement la date qui se trouve dans cette même cellule, avant les mots "AR fait au syndic". Voilà comment j'ai décidé de procéder : cette date reste toujours à même distance des mots "AR fait au syndic" (pos-36 à pos-25), j'ai donc pensé à balayer toute la colonne grâce à un tableau, récupérer la position d'apparition de "AR fait au syndic", grâce à ça j'ai maintenant la plage de la chaîne de caractère ou se trouve la date. C'est là que je rencontre un blocage. je n'arrive pas à faire de boucle for pour parcourir cette plage dans une chaîne de caractère, le but final est de remplacer le contenu de la cellule par cette date, soit en supprimer le reste ou en copiant cette plage et en la collant à la place de la cellule.

Exemple :

Le contenu de la cellule H2 :" *<< 07/12/2020-17:13-A9ERIM-MACE7235>> Transmis au ST<< 01/04/2021-11:24-XFRRAC-TXGJ2087>> toujours aucun retour du prestataire malgré les relances du 10/09/20 (voir TRAC) et du 07/12/2020 // sollicite une nouvelle relance et être tenu informé svp<< 08/04/2021-10:34-A9ERIM-MACE7235>> AR fait au syndic<< 11/04/2021-10:36-A9ERIM-MACE7235>> Relance le partenaire"

L'objectif est de remplacer le contenu de la cellule H2 par 08/04/2021 la date qui se trouve avant.

Merci d'avance pour vos conseils et recommandations.

Bonjour,

Inutile de boucler sur les caractères, si la position relative de la date à extraire est toujours la même par rapport au texte cherché. Exemple :

Sub Date_AR()

Dim ma_chaine As String, Lig As Long, LigMax As Long, pos As Integer

LigMax = [A65000].End(xlUp).Row 'Dernière ligne remplie
ma_chaine = "AR fait au syndic" 'Texte cherché
For Lig = 2 To LigMax 'Boucle sur la totalité
     pos = InStr(1, Cells(Lig, 8), ma_chaine, 1) 'Position du texte cherché
     Cells(Lig, 9) = Replace(Mid(Cells(Lig, 8), pos - 35, 16), "-", " ") 'Extraction de la date en cellule adjacente
Next Lig

End Sub

Bonjour,

Edit : Salut Pedro,

Pour poster du code, vous pouvez utiliser les balises </> du ruban d'icônes.

Voici un essai à adapter :

with range("nomtableau") 'adapter nom du tableau structuré
    tbl = .columns(8).value
    for i = lbound(tbl) to ubound(tbl)
        tbl(i, 1) = GetDate(cstr(tbl(i, 1)))
    next i
    .columns(8).value = tbl
end with

function GetDate(chaine$) as date
t = split(chaine, "-")
for i = 1 to len(t(0))
    if not mid(t(0), i, 1) like "[0-9/]" then mid(t(0), i, 1) = " "
next i
GetDate = cdate(replace(t(0), " ", ""))
end function

Cdlt,

Un grand merci à vous 3GB et Pedro22, vos deux méthodes fonctionnent.

Je vous souhaite de passer une excellente journée.