XL 2010 Macro "remplacer par" successifs

nicopat

XLDnaute Junior
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
 
Solution
C'est bon, j'ai la solution :

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

nicopat

XLDnaute Junior
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.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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" :
VB:
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
 

Pièces jointes

  • nicopat- remplacer en masse- v1.xlsm
    40 KB · Affichages: 4

nicopat

XLDnaute Junior
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).
 

Pièces jointes

  • nicopat- remplacer en masse- v1.xlsm
    711.7 KB · Affichages: 4
Dernière édition:

nicopat

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

XLDnaute Junior
C'est bon, j'ai la solution :

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

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG