Macro suppression caracères à droite.

[Anto35200]

Dans mon fichier ci-joint, je voudrai remplacer certain libellé par un autre.

Exemple :

Tous les libellés (en rouge) « CIONS REM N XXXXXXXXXXXXXXXXXXX » sera remplacé par
« COM REMISE EFFETS ».

Quelles la meilleure méthode pour effectuer cette tâche ?

J’avais pensé à mettre une macro qui me permet dans un 1er temps de supprimer les caractères de droite et ne garder « CIONS REM N » et dans un 2nd temps, remplacer ce libellé par «« COM REMISE EFFETS ».
Le problème, c’est que je ne sais pas l’appliquer à l’ensemble du fichier.
Voici ma macro :

Sub test()

'Suppression des 20 dernires caractères'
ActiveCell = Left(ActiveCell, Len(ActiveCell) - 20)

'Remplacer par nouveau libellé'
ActiveCell.Replace What:="CIONS REM N", Replacement:="COMM REMISES EFFETS" _
        , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
    Cells.Find(What:="CIONS REM N", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
End Sub

En vous remerciant par avance de votre aide.

 

[NezQuiCoule]

Re : Macro suppression caracères à droite.

Bonjour,

Je propose une solution :

Sub test()

    Dim Ligne As Integer
    Ligne = 11
    
    While Cells(Ligne, 1) <> ""
        If InStr(1, Cells(Ligne, 8), "CIONS REM N ", vbBinaryCompare) <> 0 Then Cells(Ligne, 8) = "COMM REMISES EFFETS"
        Ligne = Ligne + 1
    Wend

End Sub

 

[Marc L]

Re : Macro suppression caracères à droite.

Bonjour,

une rapide démonstration via un filtre avancé :

​

Sub Demo()
    [Z1:Z2].Value = [{"Libellé";"CIONS REM N *"}]
    With [A10].CurrentRegion.Columns(8)
        .AdvancedFilter xlFilterInPlace, [Z1:Z2]
        If .SpecialCells(xlCellTypeVisible).Count > 1 Then .Value = "COM REMISE EFFETS"
    End With
    ActiveSheet.ShowAllData
    [Z1:Z2].Clear
    ActiveWindow.ScrollRow = 1
End Sub

_______________________________________________________________________________
Merci de cliquer sur J'aime ce post pour chaque message ayant aidé …

_______________________________________________________________________________
Je suis Charlie - Je suis Bardo​

 

[Anto35200]

Re : Macro suppression caracères à droite.

Bonjour,


Merci à NezQuiCoule et Marc L. de vos réponses. C'est exactement çà !

Juste une dernière requête.

Comment peut-on remplacer par une macro, ces 3 libellés sur toute la plage de la feuille :
"ABON TURBO ON LINE ENT", "COTIS CYBERPLUS" et "FRAIS VIR EUROP. PAPIER" par "ABONN TELETRANSMISSION".
Ma macro du post1 ne me permet que de remplacer qu'une seule ligne.

En vous remerciant encore d'avance de votre aide.

 

[Modeste]

Re : Macro suppression caracères à droite.

Bonjour le fil,

J'enfonce peut-être une porte ouverte (mais j'aime bien: je ne me fatigue pas trop, dans ce cas!) ... mais pourquoi pas un simple "Rechercher-Remplacer"?
Rechercher: CIONS REM N * > Remplacer par: COM REMISE EFFETS

 

[Anto35200]

Re : Macro suppression caracères à droite.

Bonjour Modeste,

Comment fais-tu pour appliquer la macro suivante à l'ensemble de la plage ?

ActiveCell.Replace What:="FRAIS OPPOSITION CHEQUE", Replacement:="FRAIS OPPOSITION" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
:=False, ReplaceFormat:=False
Cells.Find(What:="FRAIS OPPOSITION CHEQUE", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub

 

[Modeste]

Re : Macro suppression caracères à droite.

Re,

Bonjour Modeste,
Comment fais-tu pour appliquer la macro suivante à l'ensemble de la plage ?

Ah mais moi, je n'ai même pas parlé de macro!

Tu devrais préciser, par ailleurs, si ta nouvelle demande est encore en lien avec la première?
Derrière tes 3 mentions, tu n'as plus les 20 caractères à supprimer?
toute la plage de la feuille, c'est ... toute la feuille? Une colonne précise? Une plage déterminée?

Si les propositions de NezQuiCoule et Marc L te conviennent, tu ne peux pas les adapter, plutôt que de rester "accroché" au premier code que tu avais dégotté comme un noyé à une bouée et j'insiste sur le : je ne critique pas, ni ne me moque. Cette macro ne fait le remplacement que dans la cellule active (ActiveCell). Elle recherche ensuite l'occurence suivante dans la feuille; il faudrait donc la ré-exécuter autant de fois qu'il y a d'occurences des termes recherchés dans la feuille ... C'est pour cette raison que j'avais proposé un Rechercher-Remplacer: dans ce cas, tu peux faire Remplacer tout. Ta macro équivaudrait à faire Suivant, puis Remplacer et ainsi de suite, jusqu'au dernier remplacement.

Plus tu donneras de précisions, plus les propositions ont des chances de "coller" à ton besoin.

 

[job75]

Re : Macro suppression caracères à droite.

Bonjour à tous,

Modeste a bien vu la bonne soluton :

Sub test()
Columns("H").Replace "CIONS REM N*", "COMM REMISES EFFETS", xlWhole
End Sub

@ Marc L : ne pas abuser du filtre avancé voir le précédent fil de plimosin.

A+

 

[job75]

Re : Macro suppression caracères à droite.

Re,

Pour ce qui est du problème posé au post #4 :

Sub test()
Dim a, i
a = Array("ABON TURBO ON LINE ENT", "COTIS CYBERPLUS", "FRAIS VIR EUROP. PAPIER")
For i = 0 To UBound(a)
Columns("H").Replace a(i), "ABONN TELETRANSMISSION", xlPart
Next
End Sub

A+

 

[job75]

Re : Macro suppression caracères à droite.

Re,

Testé le dernier problème sur 10000 lignes.

Le filtre avancé est un peu moins rapide que le remplacement direct par Replace.

Fichiers joints.

A+

 

[job75]

Re : Macro suppression caracères à droite.

Re,

Mais comme d'habitude la solution de loin la plus rapide est celle qui utilise un tableau VBA (matrice) :

Sub test()
Dim t, a, ub As Byte, remp$, tablo, i&, x$, j As Byte
t = Timer
a = Array("ABON TURBO ON LINE ENT", "COTIS CYBERPLUS", "FRAIS VIR EUROP. PAPIER")
ub = UBound(a)
remp = "ABONN TELETRANSMISSION"
tablo = Intersect(ActiveSheet.UsedRange.EntireRow, Columns("H")) 'matrice, plus rapide
For i = 1 To UBound(tablo)
  x = tablo(i, 1)
  For j = 0 To ub
    If InStr(x, a(j)) Then tablo(i, 1) = remp: Exit For
  Next
Next
Intersect(ActiveSheet.UsedRange.EntireRow, Columns("H")) = tablo
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Fichier sur 10000 lignes joint.

A+

 

[Marc L]

Re : Macro suppression caracères à droite.

Sans tester, Replace est plus rapide et j'ai loupé dans le code initial l'astérisque manquant …


_______________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !

​

 

[job75]

Re : Macro suppression caracères à droite.

Re Marc L,

Puisque vous êtes sur Excel 2003, ci-joint les 3 fichiers .xls zippés pour que vous puissiez tester.

A+

 

[job75]

Re : Macro suppression caracères à droite.

Re,

J'ai testé sur mon vieil ordi avec Excel 2003, curieusement la 3ème méthode n'est pas la plus rapide :

- avec Replace => 0,05 s

- avec filtre avancé => 0,07 s

- avec tableau VBA => 0,08 s.

Mais les écarts sont finalement faibles, l'erreur de mesure étant de 0,01 à 0,02 s.

A+

 

[Marc L]

Re : Macro suppression caracères à droite.

Merci !

Résultats : (roulements de tambours !)

• Direct : 0,055s

• Filtre .: 0,063s

• Array : 0,031s …

_______________________________________________________________________________
Ne pas confondre faux départ et paravent !
​