Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

raf26

XLDnaute Occasionnel
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
 

Pièces jointes

  • Classeur1.xlsx
    10.1 KB · Affichages: 15

Dranreb

XLDnaute Barbatruc
Bonsoir.
Cette fonction perso renvoie les résultats attendus :
VB:
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 :
Code:
   TJn = Split(Replace(Z, ")(", ") ("), "(")
 
Dernière édition:

fanch55

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

VB:
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

XLDnaute Occasionnel
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) ?

VB:
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Raf, Dranreb, Fanch,
Ou encore avec ceci :
VB:
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 :
Code:
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
 

Pièces jointes

  • Classeur1 (2).xlsm
    16 KB · Affichages: 3

Staple1600

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous ,

Une autre petite fonction personnalisée qui fait le boulot :
VB:
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

XLDnaute Occasionnel
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é
VB:
Range("B14:B180") = Nettoie(Range("B14:B180"))

mais cela ne marche pas
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Range("B14:B180") = Nettoie(Range("B14:B180"))
Ce serait trop simple.
Une possibilité :
VB:
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 :
Code:
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 :
Code:
Sub test()
Nettoie ("B14:B180")
End Sub
 
Dernière édition:

raf26

XLDnaute Occasionnel

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 ?

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

fanch55

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

VB:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…