Récupérer un mot spécifique dans un texte

Bonjour,

J'aimerais récupérer dans un texte tout les mots commencements par NG ou TO:

"Aujourd'hui, en l'an TO123 j'ai rencontré Mr NG564 et Mme NG632, tout deux âgées respectivement de TO58 et TO60"

D'avance merci,

Michel

Bonjour,

C'est tout à fait faisable en macro, mais peux-tu fournir au préalable un fichier représentatif de ton besoin, que l'on s'en serve comme base de travail ?

8test1.xlsx (13.98 Ko)

Voilà ma proposition :

Sub RetrouverMotsComplets()

Dim i As Long, j As Integer, k As Integer, Tablo(), MotsRef(), TextDecoup() As String

MotsRef() = Sheets(2).Range("A2:A" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value 'Affecte les extraits à retrouver dans une variable tableau
With Sheets(1) 'Toute instruction commençant par "." se rattache à la 1ère feuille
    Tablo() = .Range("B2:B" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Affecte la plage à contrôler dans une variable tableau
    For i = LBound(Tablo) To UBound(Tablo) 'Parcourir la plage à contrôler
        If Not Tablo(i, 1) = "" Then
            TextDecoup = Split(Tablo(i, 1), " ") 'Découper le texte mot à mot
            For j = LBound(TextDecoup) To UBound(TextDecoup) 'Parcourir les mots
                For k = LBound(MotsRef) To UBound(MotsRef) 'Parcourir les extraits de référence
                    If TextDecoup(j) Like "*" & MotsRef(k, 1) & "*" Then Sheets(2).Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(Replace(TextDecoup(j), Chr(10), ""), ",", "") 'Comparer et ajouter le mot si correspondance partielle
                Next k
            Next j
        End If
    Next i
End With

Ajoutée à ton fichier :

2michellaugier.xlsm (27.47 Ko)

Bonjour,

Avec fonction perso.

Function extrait(cel)
  Application.Volatile
  temp = Replace(cel, ",", " ")
  Dim Tbl()
  a = Split(temp, " ")
  j = 0
  For i = 0 To UBound(a)
    If Left(a(i), 2) = "TO" Or Left(a(i), 2) = "NG" Then
      j = j + 1
      ReDim Preserve Tbl(1 To j)
      Tbl(j) = a(i)
    End If
  Next i
  extrait = Join(Tbl, ",")
End Function

Boisgontier

Bonjour à tous ... Michellaugier , Pedro, Jacques Boisgontier

C'est aussi l'objet des expressions régulières (un peu pointues parfois mais terriblement efficaces).

J'ai donc développé une fonction personnalisée générique pour cela.

Function ChercheChaine(chaine, pattern, indice)
  Set obj = CreateObject("vbscript.regexp")
  obj.pattern = pattern
  obj.Global = True
  Set a = obj.Execute(chaine)
  If indice <= a.Count Then ChercheChaine = a(indice - 1) Else ChercheChaine = ""
End Function
5test1.xlsm (18.60 Ko)
Rechercher des sujets similaires à "recuperer mot specifique texte"