Macro RECHERCHER-REMPLACER.

Résolu
Mirguy23 Messages postés 42 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Je coince un peu sur mon code ... J'ai visualisé plusieurs fichiers mais toujours des difficultés ...

Je cherche sous excel à avoir une macro me permettant de faire un remplacer-rechercher automatiquement afin de me simplifier la tâche.

Exemple:

Si PC802179-00 colonne "B" feuil1 est égal à la même valeur PC802179-00 colonne "B" feuil2 alors remplacer toute les cellules de la colonne "B" (feuil1) ayant la valeur PC802179-00 par RX134537-01 colonne "A" sur toute la feuil1.

Je vous ai joint les images pour plus de compréhension.

Quelqu'un peut me proposer un code afin que je me lance svp?

Merci de votre gentillesse !



1 réponse

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, suggestion:
    Sub g()
    Dim f1 As Worksheet, f2 As Worksheet, rg As Range
    Dim rech As Scripting.Dictionary
    Set rech = New Scripting.Dictionary
    Set f1 = ThisWorkbook.Worksheets("F1")
    Set f2 = ThisWorkbook.Worksheets("F2")
    For Each rg In Intersect(f2.Columns(2), f2.UsedRange)
        If rg.Value <> "" Then
            Call rech.Add(rg.Value, rg.Offset(0, -1).Value)
        End If
    Next rg
    For Each rg In Intersect(f1.Columns(2), f1.UsedRange)
        If rech.Exists(rg.Value) Then
            rg.Value = rech.Item(rg.Value)
        End If
    Next rg
    End Sub
    0
    1. Mirguy23 Messages postés 42 Statut Membre
       
      J'ai testé mais ça me donne une erreur de compilation ...
      0
    2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > Mirguy23 Messages postés 42 Statut Membre
       
      quelle erreur, sur quelle ligne?
      0
    3. Mirguy23 Messages postés 42 Statut Membre
       
      Erreur de compilation
      Type défini par utilisateur non défini


      Private Sub CommandButton1_Click()
      Dim Feui11 As Worksheet, Feui12 As Worksheet, rg As Range
      Dim rech As Scripting.Dictionary
      Set rech = New Scripting.Dictionary
      Set Feui11 = ThisWorkbook.Worksheets("Feui11")
      Set Feui12 = ThisWorkbook.Worksheets("Feuil2")
      For Each rg In Intersect(Feui12.Columns(2), Feui12.UsedRange)
      If rg.Value <> "" Then
      Call rech.Add(rg.Value, rg.Offset(0, -1).Value)
      End If
      Next rg
      For Each rg In Intersect(Feui11.Columns(2), Feui11.UsedRange)
      If rech.Exists(rg.Value) Then
      rg.Value = rech.Item(rg.Value)
      End If
      Next rg
      End Sub
      0
    4. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > Mirguy23 Messages postés 42 Statut Membre
       
      Il faut ajouter "microsoft scripting runtime" dans les références du projet.
      0
    5. Mirguy23 Messages postés 42 Statut Membre > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
       
      Aucune erreur mais ça ne marche pas ...
      J'ai coché la référence "microsoft scripting runtime".
      0