XL 2010 Macro "remplacer par" successifs

[nicopat]

Bonjour,

J'utilise xl2007.
Je cherche une macro pour réaliser successivement des "remplacer par" dans une plage de cellules.

Disons que cette plage se trouve dans la "Feuille 1", disons dans la plage A10:Z9999.

Et dans la plage de la "Feuille 2" B1:C1000 (c'est un exemple, mais le nombre de ligne de cette plage est variable), j'ai listé sous forme de tableau la liste des "remplacer par" à réaliser (colonne B : les expressions à rechercher ; colonne C : les expressions par lesquelles il faut remplacer les expressions précédentes).

Je cherche à rédiger la macro permettant de réaliser ces "remplacer par" successifs tel que décrit ci-dessus.


Merci d'avance

 

[nicopat]

Est-ce que mon problème est clairement expliqué?

Dans mon exemple ci-dessus, on doit lancer les "remplacer par" successifs dans la plage de la "Feuille 1" en remplaçant l'expression trouvé dans la cellule B1 de la "Feuille 2" par le contenu de la cellule C1 de la "feuille 2", puis B2 par C2, etc... jusqu'à B1000 par C1000.

 

[Phil69970]

Bonjour @nicopat


J'ai cherché partout mais j'ai pas vu ton fichier !!!

@Phil69970

 

[nicopat]

en voilà un.

 

[nicopat]

si une macro n'est pas possible, existe-t-il une formule ?

 

[mapomme]

Bonsoir @nicopat 🙂, @Phil69970 😉 ,

1. initialiser les données en cliquant sur le bouton Init.
2. puis cliquez sur le bouton Hop!

Voir le code dans le module "module1" :

Sub remplacer()
Dim dico, derlig&, t, i&, j&, deb

deb = Timer
Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = TextCompare
With Sheets("Feuil2")
   If .FilterMode Then .ShowAllData
   derlig = .Cells(.Rows.Count, "b").End(xlUp).Row
   t = .Range("b1").Resize(derlig, 2)
   For i = 1 To UBound(t)
      If t(i, 1) <> "" Then dico.Add t(i, 1), t(i, 2)
   Next i
End With
With Sheets("Feuil1")
   If .FilterMode Then .ShowAllData
   derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
   t = .Range("a10:a" & derlig).Resize(, 26)
   For i = 1 To UBound(t): For j = 1 To 26
      If t(i, j) <> "" Then If dico.Exists(t(i, j)) Then t(i, j) = dico(t(i, j))
   Next j, i
   .Range("a10").Resize(UBound(t), UBound(t, 2)) = t
End With
MsgBox "remplacement en " & Format(Timer - deb, "0.0\ sec.")
End Sub

 

[nicopat]

Bonjour @mapomme @Phil69970

quand je remplace le contenu Avant/après par d'autres valeurs, la macro échoue et c'est cette partie qui est en jaune :

dico.Add t(i, 1), t(i, 2)

Une précision (je ne sais pas si c'est important) : les "remplacer par" ne doivent pas être en "cellule entière", c'est à dire que le texte à remplacer peut être une partie du contenu d'une cellule (et non son contenu intégral). Et il peut y avoir des doublons aussi bien dans les données initiales (feuillet 1) que dans le feuillet 2.

Cf exemple ci-joint (j'ai également modifier les noms de feuillets pour inclure un espace, comme dans mon fichier dans lequel je veux mettre en pratique cette macro).

 

[nicopat]

j'ai essayé de modifier la macro de @mapomme mais je n'arrive à rien, je ne comprends pas à quoi sert cette partie de code en jaune.

 

[nicopat]

Quelqu'un sait à quoi sert "dico.Add" dans la macro proposée par @mapomme ?

Je ne comprends pas d'où provient cette erreur dans la dernière version uploadée du fichier test.

C'est assez étonnant d'ailleurs qu'excel ne propose pas nativement une solution pour faire des "remplacer par" successifs

 

[nicopat]

C'est bon, j'ai la solution :

Sub Remplacer()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_A As Long, DerLig_B As Long, i As Long
    Dim Valeur_X As String, Valeur_Y As String
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuillet_A")
    Set f2 = Sheets("Feuillet_B")

    DerLig_A = f1.Range("Z1").CurrentRegion.Rows.Count
    DerLig_B = f2.Range("X1").CurrentRegion.Rows.Count

    For i = 1 To DerLig_B
        Valeur_X = f2.Cells(i, "X")
        Valeur_Y = f2.Cells(i, "Y")
        f1.Range("Z1:AA" & DerLig_A).Replace What:=Valeur_X, Replacement:=Valeur_Y, LookAt:=xlPart
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
End Sub