Encadrer un mot après un caractère spécifique macro VBA

Version imprimable

27/05/2020, 18h00
taha-ba

Encadrer un mot après un caractère spécifique macro VBA

bonjour

Dans un fichier excel une cellule contient un texte, je voudrais encadrer un mot qui vient après un caractère. Ce caractère est bien défini.
est ce que je peux le faire à l'aide d'une macro
Exemple:
Julien va à l'école à pied
Julien va (école) (pied)
Dans mon exemple mon caractère défini est "à" donc le caractère qui vient après école et pied je dois les encadrer par des parenthèses.

j'ai cherché beaucoup sur des forum mais j'ai pas trouvé une réponse
Merci d'avance.

Bonjour,

Proposition, en colonne "A" le(s) caractère(s) à trouver, en colonne "B" la phrase complète à trouver, en colonne "C", la phrase reconstituée sans le(s) caractère(s) à trouver.

le fichier en exemple
Pièce jointe 568454

Le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Extraire()
    Dim DerLig As Long, L As Long, Cpt As Long, i As Long
    Dim Ph As String
    Dim Ext As Variant
    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    If DerLig > 1 Then
        Range(Cells(2, "C"), Cells(DerLig, "C")).ClearContents
        For L = 2 To DerLig
            Ph = Cells(L, "B").Value
            Cells(L, "C").Value = Ph
            Ext = Split(Ph, " " & Cells(L, "A") & " ")
            ReDim Isol(0) As String
            For i = 1 To UBound(Ext)
                Isol(Cpt) = "(" & Ext(i) & ")"
                Cpt = Cpt + 1
                ReDim Preserve Isol(Cpt)
            Next
 
            'supprime le caractère spécifique dans la phrase
            Cells(L, "C").Replace What:=" " & Cells(L, "A") & " ", Replacement:=""
 
            'Affiche les mots à conserver entre parenthèses
            For i = 0 To Cpt - 1
                Cells(L, "C").Replace What:=Ext(i + 1), Replacement:="   " & Isol(i)
            Next i
            Cpt = 0
        Next L
    End If
End Sub

Cdlt

27/05/2020, 20h03
taha-ba

Merci pour votre code ça fonctionne bien sauf que j'a un petit problème je voudrais juste encadrer que le mot qui vient après le caractère "à" et non pas tous les mots après. est-ce-qu'il y a une solution possible pour ce problème.

par exemple:
je vais à l'école avec mon ami à pied
le résultat :
je vais (l'école) avec mon ami (pied)
Merci autre fois

Bonjour,

Voici la modif
Pièce jointe 568541

le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub Extraire()
    Dim DerLig As Long, L As Long, Cpt As Long, i As Long
    Dim Parenth_Ouv As Long, Parenth_Fer As Long
    Dim Ph As String, Var As String
    Dim Ext As Variant
    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    If DerLig > 1 Then
        Range(Cells(2, "C"), Cells(DerLig, "C")).ClearContents
        For L = 2 To DerLig
            Ph = Cells(L, "B").Value
            Cells(L, "C").Value = Ph
            Ext = Split(Ph, " " & Cells(L, "A") & " ") 'Extraction du mot
            ReDim Isol(0) As String
            For i = 1 To UBound(Ext)
                Isol(Cpt) = "(" & Ext(i) & " " 'Ajout de la parenthèse ouvrante
                Cpt = Cpt + 1
                ReDim Preserve Isol(Cpt)
            Next
 
            'supprime le caractère spécifique dans la phrase
            Cells(L, "C").Replace What:=" " & Cells(L, "A") & " ", Replacement:=""
 
            'Affiche les mots à conserver entre parenthèses
            For i = 0 To Cpt - 1
                Cells(L, "C").Replace What:=Ext(i + 1), Replacement:="   " & Isol(i)
            Next i
 
            'Ajout de la parenthèse fermante
            Parenth_Ouv = 1
            For i = 0 To Cpt - 1
                Parenth_Ouv = InStr(Parenth_Ouv, Cells(L, "C"), "(", 1)
                Parenth_Fer = InStr(Parenth_Ouv, Cells(L, "C"), " ", 1) - 1
                Var = Left(Cells(L, "C"), Parenth_Fer - 1) & Mid(Cells(L, "C"), Parenth_Fer, 1) & ") " & Mid(Cells(L, "C"), Parenth_Fer + 1, Len(Cells(L, "C")) - Parenth_Fer)
                Cells(L, "C").Value = Var
                Parenth_Ouv = Parenth_Fer + 1
            Next
            Cpt = 0
        Next L
    End If
End Sub

Cdlt