Microsoft 365 VBA supprimer toutes les parenthèses sauf les 2 dernieres

[raf26]

Bonjour,

J'aurais besoin de votre aide pour une macro

Je reçois des lignes de livraisons, avec aléatoirement des mots entre parenthèses et toujours la variété en dernier entre parenthèses.

Ces lignes sont collés par macro dans un tableau et ensuite une formule m'extrait la variété entre parenthèses.

Seulement si d'autres parenthèses sont présentes avant celles de la variété ma formule échoue.

Je chercher donc à intégré à ma macro de collage la "formule" qui me supprime toutes les parenthèses sauf les 2 dernières.

J'ai bien essayé avec l'enregistreur de macro et la fonction remplacer mais cela ne me permets pas de sélectionner certaines parenthèses.

Exemple
ligne reçue POMME (Espagne) CAL 3 (golden)
ligne collée après traitement macro POMME Espagne CAL 3 (golden)

J'espère avoir été assez claire dans ma demande.

Je vous joins un fichier exemple.

Merci d'avance

Cordialement

 

[Dranreb]

Bonsoir.
Cette fonction perso renvoie les résultats attendus :

Function SsParthMilieu(ByVal Z As String) As String
   Dim TJn() As String, P As Integer
   TJn = Split(Z, "(")
   For P = 0 To UBound(TJn) - 1
      TJn(P) = Replace(TJn(P), ")", "")
      Next P
   TJn(P) = "(" & TJn(P)
   SsParthMilieu = Join(TJn, "")
   End Function

… sauf pour POMME (France)(PACA) (pink lady)
qui donne POMME FrancePACA (pink lady)
Peut se réparer si nécessaire en changeant la 3ème instruction :

   TJn = Split(Replace(Z, ")(", ") ("), "(")

 

[fanch55]

Bonsoir,
Même combat que Dranreb sauf renvoi différent pour les pink lady :

Function Blabla(Cel As Range)
    T = Split(Cel, "(")
    For I = 0 To UBound(T) - 1
        T(I) = Replace(T(I), ")", " ")
    Next
    T(UBound(T)) = "(" & T(UBound(T))
    Blabla = Join(T)
End Function

Appel fonction dans cellule :

 

[raf26]

Bonjour Dranreb et fanch55

Merci pour vos retours hyper rapide !

Je vais tester vos 2 solutions, toutefois une question, comment insérer votre macro dans la mienne (ci-dessous) ?

Sheets("mononglet").Select
    Range("DA38").Select
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:= _
                             False
    Range("DA38").Select
End Sub

J'ai un bouton qui me déclenche cette macro de collage

 

[Dranreb]

Ben ajoutez

Range("DA38").Value = SsParthMilieu(Range("DA38").Value)

 

[sylvanu]

Bonsoir Raf, Dranreb, Fanch,
Ou encore avec ceci :

Function Nettoie(C$)
    Pos = InStrRev(C, "(")
    C1 = Replace(Replace(Mid(C, 1, Pos), "(", ""), ")", "")
    Nettoie = C1 & " " & Mid(C, Pos)
End Function

et dans votre macro (perfectible ) on doit pouvoir faire :

Sub essai()
    Sheets("mononglet").Select
    Range("DA38").Select
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
    Range("DA38").Select
    Range("DA38") = Nettoie(Range("DA38"))
End Sub

 

[raf26]

Bonsoir Sylvanu,

votre macro (perfectible )

C'est l'enregistreur de macro

 

[raf26]

Je teste vos solutions demain matin et vous redit.

Encore merci à vous 3 pour la rapidité de vos retours, vous êtes impressionnants.

 

[Staple1600]

Bonjour

Puisque le préfixe indique Microsoft 365
Une formule (un peu longue) qui semble OK
=SUBSTITUE(SUBSTITUE(TEXTE.AVANT(A1;"(";NBCAR(A1)-NBCAR(SUBSTITUE(A1;"(";"")));")";"");"(";"")&"("&TEXTE.APRES(A1;"(";NBCAR(A1)-NBCAR(SUBSTITUE(A1;"(";"")))

 

[Staple1600]

Re

Toujours grâce à 365, on peut raccourcir la formule en
=SUBSTITUE(SUBSTITUE(PMOT(A1);"(";"");")";"")&DMOT(A1)
(en utilisant la fonction LAMBDA)

DMOT	=LAMBDA(chaine;"("&FILTRE.XML("<t><s>" & SUBSTITUE(chaine;"(";"</s><s>") &"</s></t>"; "//s[last()]"))
PMOT	=LAMBDA(chaine;GAUCHE(chaine;CHERCHE(DMOT(chaine);chaine)-1))

NB: DMOT et PMOT sont donc des formules nommées qui apparaissent dans le gestionnaire de noms

 

[mapomme]

Bonsoir à tous ,

Une autre petite fonction personnalisée qui fait le boulot :

Function DernierTerme$(ByVal x$)
Dim n&, y$, z$
   n = InStrRev(x, "("): If n = 0 Then Exit Function
   y = Left(x, n - 1): y = Replace(Replace(y, "(", "  "), ")", "  "): z = " " & Mid(x, n)
   DernierTerme = Application.Trim(y & z)
End Function

 

[raf26]

Bonsoir Raf, Dranreb, Fanch,
Ou encore avec ceci :

Function Nettoie(C$)
    Pos = InStrRev(C, "(")
    C1 = Replace(Replace(Mid(C, 1, Pos), "(", ""), ")", "")
    Nettoie = C1 & " " & Mid(C, Pos)
End Function

et dans votre macro (perfectible ) on doit pouvoir faire :

Sub essai()
    Sheets("mononglet").Select
    Range("DA38").Select
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
    Range("DA38").Select
    Range("DA38") = Nettoie(Range("DA38"))
End Sub

Bonjour Sylvanu,

Si je souhaite appliquer votre macro à ma plage qui est collée

Ex de : B14 à B180, quelles références je dois spécifier ?

J'ai essayé

Range("B14:B180") = Nettoie(Range("B14:B180"))

mais cela ne marche pas

 

[sylvanu]

Range("B14:B180") = Nettoie(Range("B14:B180"))

Ce serait trop simple.
Une possibilité :

For L = 14 To 180
    Cells(L, "B") = Nettoie(Cells(L, "B"))
Next L

ou si la plage est grande, pour être plus rapide, ou peut être est ce plus simple :

Sub Nettoie(Plage)
tablo = Range(Plage)
For i = 1 To UBound(tablo)
    C = tablo(i, 1)
    Pos = InStrRev(C, "(")
    C1 = Replace(Replace(Mid(C, 1, Pos), "(", ""), ")", "")
    If tablo(i, 1) <> "" Then tablo(i, 1) = C1 & " " & Mid(C, Pos)
Next i
Range(Plage) = tablo
End Sub

et l'appel se fait par :

Sub test()
Nettoie ("B14:B180")
End Sub

 

[raf26]

Bonsoir à tous ,

Une autre petite fonction personnalisée qui fait le boulot :

Function DernierTerme$(ByVal x$)
Dim n&, y$, z$
   n = InStrRev(x, "("): If n = 0 Then Exit Function
   y = Left(x, n - 1): y = Replace(Replace(y, "(", "  "), ")", "  "): z = " " & Mid(x, n)
   DernierTerme = Application.Trim(y & z)
End Function

Bonjour mapomme,

Je voudrais tester ta fonction, merci de ton retour.

Je la copie dans un nouveau module, mais comment l'appeler dans ma macro de collage ?

Sheets("mononglet").Select
    Range("DA38").Select
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:= _
                             False
    Range("DA38").Select
End Sub

 

[fanch55]

Bonjour,
Le pasteSpecial indiqué est spécifique à un copy externe à Excel :
Un exemple avec votre extrait de code :

Option Explicit
' -----------------------------------------------------------------------------------------
Sub Coller_Ext()
Dim Cel As Range

' on suppose que le copier a été effectué sur une appli externe

Sheets("mononglet").Select
    Range("DA38").Select
    ActiveSheet.PasteSpecial Format:="Texte"
    For Each Cel In Selection.Cells
        Cel = Blabla(Cel)
    Next
End Sub
' -----------------------------------------------------------------------------------------
Sub Coller_Range()
Dim Cel As Range

' on suppose que le copier a été effectué sur un range de cellules
'      Sheets("Feuil1").Range("E8:E11").Copy

Sheets("mononglet").Select
    Range("DA38").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    For Each Cel In Selection.Cells
        Cel = Blabla(Cel)
    Next
End Sub
' -----------------------------------------------------------------------------------------
Function Blabla(Cel As Range)
Dim T, I
    T = Split(Cel, "(")
    For I = 0 To UBound(T) - 1
        T(I) = Replace(T(I), ")", " ")
    Next
    T(UBound(T)) = "(" & T(UBound(T))
    Blabla = Join(T)
End Function