XL 2010 Macro RECHERCHER-REMPLACER.

Mirguy23

XLDnaute Nouveau
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 !
 

Fichiers joints

Mirguy23

XLDnaute Nouveau
Voici mon fichier.

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

Fichiers joints

Mirguy23

XLDnaute Nouveau
Si la valeur X de la feuil1 trouve sa correspondance dans la feuil2 alors il remplace son ancienne dénomination (ex: PC802171-00) par sa nouvelle correspondance X (ex: RX134537-02)
 

Calvus

XLDnaute Barbatruc
Bonsoir Mirguy, le forum,

Voici :

VB:
Sub Remplace()
Dim i%, j%, f1 As Worksheet, f2 As Worksheet, derlignef1%, derlignef2%

Set f1 = Feuil1
Set f2 = Feuil2

derlignef1 = f1.Cells(Rows.Count, 2).End(xlUp).Row
derlignef2 = f2.Cells(Rows.Count, 2).End(xlUp).Row

For i = 1 To derlignef1
    For j = 1 To derlignef2
        If f2.Cells(j, 2) = f1.Cells(i, 2) Then
            f1.Cells(i, 2) = f2.Cells(j, 1)
        End If
    Next j
Next i

End Sub
Et ton fichier en retour.

A+
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Une façon formulée de faire (avec au préalable un petit réagencement)
1) Intervertion des colonnes A et B en feuille 1 (et nommage de la plage A1:C8 en BASE)
Dans la colonne insérée en feuille 1, mettre cette formule
=SI(ESTNA(RECHERCHEV(B1;BASE;2;0));B1;RECHERCHEV(B1;BASE;2;0))
ou celle-ci pour les dernières versions d'Excel
=SIERREUR(RECHERCHEV(B1;BASE;2;0);B1)
2) Insertion d'une colonne en feuil1

Et sa traduction en VBA donnerait
VB:
Sub Macro1()
Dim DL&
DL = Cells(Rows.Count, 1).End(3).Row: Columns(1).Insert Shift:=xlToRight
Range("A1:A" & DL).FormulaR1C1 = _
    "=IF(ISNA(VLOOKUP(RC[1],BASE,2,0)),RC[1],VLOOKUP(RC[1],BASE,2,0))"
Range("A1:A" & DL) = Range("A1:A" & DL).Value: Columns(2).Delete
End Sub
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas