Microsoft 365 Code VBA pour rechercher et remplacer une valeur dans une plage de données

[khenri]

Bonjour,

je débute sur les macros excel et j'ai besoin de votre aide :
J'ai 3 colonnes A, B, C
- A avec des données Chiffres (A2:A1000)
- B avec des données chiffres (B2:B40)
- C avec des données texte (C2:C40)
Je souhaite remplacer les données de la colonne A en recherchant la valeur de chaque
cellule dans B, puis remplacer cette valeur par C.

Plus simple:

On recherche le correspond de A dans B, puis on remplace A par C (sachant que B=C)


Merci de votre aide

 

[Staple1600]

Bonjour le fil

khenri (Bienvenue sur le forum)
Un petit fichier exemple concocté par tes soins rendrait nos réponses plus faciles et plus rapides

 

[khenri]

Bonjour Staple 1600,
Ci-joint mon fichier...
je souhaite remplacer les valeurs A par C, sachant que B=C

Merci d'avance

 

[Staple1600]

Re

Voici une petite macro basique

Sub Remplacer()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range(Cells(2, 1), Cells(Rows.Count, 1).End(3))
c = Application.VLookup(c, Range("$B$2:$C$49"), 2, 0)
Next
End Sub

 

[khenri]

Sub Remplacer() Dim c As Range Application.ScreenUpdating = False For Each c In Range(Cells(2, 1), Cells(Rows.Count, 1).End(3)) c = Application.VLookup(c, Range("$B$2:$C$49"), 2, 0) Next End Sub

Merci beaucoup Staple 16000,
C'est exactement cela...tout est parfait

 

[Staple1600]

Re

Une autre solution (moins basique)
(juste pour varier les plaisirs - on utilise ici les tableaux (ou Array))

Sub RemplacerII()
Dim t, v, i&
t = Range(Cells(2, 1), Cells(Rows.Count, 1).End(3)): v = Range("$B$2:$C$49")
Application.ScreenUpdating = False
For i = LBound(t, 1) To UBound(t, 1)
x = Application.Match(t(i, 1), Application.Index(v, , 1), 0)
t(i, 1) = v(x, 2)
Next i
[A2].Resize(UBound(t, 1) + 1) = t
End Sub

NB: Normalement, c'est plus rapide quand il y a beaucoup de données à traiter.
Je te laisse tester et comparer les deux macros (en testant sur une colonne A contenant par exemple 50 000 lignes)

 

[Staple1600]

Re

Et pour finir (en ce qui me concerne)
Une dernière variante d'écriture (avec des endives )

Sub RemplacerIII()
Dim t, v, i&
t = Range(Cells(2, 1), Cells(Rows.Count, 1).End(3)): v = Range("$B$2:$C$49")
With Application
  .ScreenUpdating = False
  For i = LBound(t, 1) To UBound(t, 1)
  x = .Match(t(i, 1), .Index(v, , 1), 0): t(i, 1) = v(x, 2)
  Next i
End With
[A2].Resize(UBound(t, 1) + 1) = t
End Sub

 

[mapomme]

Bonjour @khenri ,

et surtout pour saluer @Staple1600

Un autre code:

Sub Substituer()
Dim t, d, i&, k&
   t = Range("a1:c" & Cells(Rows.Count, "a").End(xlUp).Row)
   Set d = CreateObject("scripting.dictionary")
   k = Cells(Rows.Count, "b").End(xlUp).Row
   For i = 1 To k: d(CStr(t(i, 2))) = t(i, 3): Next
   For i = 2 To UBound(t): t(i, 1) = d(CStr(t(i, 1))): Next
   Range("a1").Resize(UBound(t), 1) = t
End Sub

 

[Staple1600]

Bonsoir le fil

Et parce qu'il faut ici que je dise : chapeau bas, mapomme
C'est beau comme un cheval au galop
(j'avais pas d'autres rimes en tête)

 

[cloum1]

Bonsoir le fil

Et parce qu'il faut ici que je dise : chapeau bas, mapomme
C'est beau comme un cheval au galop
(j'avais pas d'autres rimes en tête)

Bonjour @khenri ,

Un autre code:

Sub Substituer()
Dim t, d, i&, k&
   t = Range("a1:c" & Cells(Rows.Count, "a").End(xlUp).Row)
   Set d = CreateObject("scripting.dictionary")
   k = Cells(Rows.Count, "b").End(xlUp).Row
   For i = 1 To k: d(CStr(t(i, 2))) = t(i, 3): Next
   For i = 2 To UBound(t): t(i, 1) = d(CStr(t(i, 1))): Next
   Range("a1").Resize(UBound(t), 1) = t
End Sub

Bonjour c'est curieux. j'ai essayé ton code et ca ne remplace pas toutes les valeurs sur mon fichier ci joint. Je premier code ne remplace pas toutes les valeurs et les autres sortent en erreur. Suis sur mac est ce que c'est pour cela ?

merci !

 

[Staple1600]

Bonsoir le fil, cloum1

=>cloum1
Oui , le dico n'est pas la CAMe du MAC
(C'est ici que le bât blesse)
Set d = CreateObject("scripting.dictionary")

Mais je laisse mapomme t'expliquer plus en détails le pourquoi du comment (vu que c'est son code)
(Et je crois me souvenir qu'il pourra de proposer une alternative à l'objet Dictionary fonctionnel sur Mac)

 

[mapomme]

Bonsoir @Staple1600 ,

J'ai répondu à @cloum1 dans la discussion ICI.

 

[Staple1600]

Bonsoir mapomme

Merci de l'avoir indiqué.
Et pas merci à cloum1 de semer des miettes de questions de-ci de-là.

 

[mobenjilali]

Bonjour @khenri ,

Un autre code:

Sub Substituer()
Dim t, d, i&, k&
   t = Range("a1:c" & Cells(Rows.Count, "a").End(xlUp).Row)
   Set d = CreateObject("scripting.dictionary")
   k = Cells(Rows.Count, "b").End(xlUp).Row
   For i = 1 To k: d(CStr(t(i, 2))) = t(i, 3): Next
   For i = 2 To UBound(t): t(i, 1) = d(CStr(t(i, 1))): Next
   Range("a1").Resize(UBound(t), 1) = t
End Sub

bonsoir
je suis vraiment intéressé par ce code, comment l'adapter pour que la substituions des données puisse se passer sur deux feuilles différentes
cdt