Comparer tableau vba

Fermé
GenieIngenieur Messages postés 16 Date d'inscription samedi 15 novembre 2014 Statut Membre Dernière intervention 17 mai 2016 - Modifié par GenieIngenieur le 17/05/2016 à 23:34
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 18 mai 2016 à 07:53
Bonsoir tout le monde,

J'ai un petit souci pour faire le traitement suivant en VBA:
DESCRIPTIF :
- feuillet 1
une colonne A remplie de données
une colonne B remplie de données
- feuillet 2
une colonne C remplie de données
une colonne D vide

Je souhaiterais pouvoir faire l'action suivante :
comparer chaque valeur de la colonne C avec les valeurs de la colonne A.
Si la valeur de la colonne C est présente dans la colonne A => récupérer la valeur de la colonne B et la coller dans la colonne D
Je vous serai reconnaissante si quelqu'un pourra m'aider à produire la macro correspondante.
Merci d'avance ^^

1 réponse

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
18 mai 2016 à 07:53
Bonjour

Ci joint proposition
http://www.cjoint.com/c/FEsfZvri8Rt

le code:
Option Explicit
'------------------------------------------------
Sub completer_colD()
Dim Derlig As Integer, T_sh1, Idx As Integer, Dico As Object, T_sh2
'Dim test
'------------------------------------Initialisations
Application.ScreenUpdating = False
With Sheets(1)
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_sh1 = .Range("A2:B" & Derlig)
Set Dico = CreateObject("scripting.dictionary")
For Idx = 1 To UBound(T_sh1)
If Not Dico.exists(T_sh1(Idx, 1)) Then Dico.Add T_sh1(Idx, 1), T_sh1(Idx, 2)
Next
'test = Dico.items
End With
With Sheets(2)
.Columns("D").ClearContents
Derlig = .Columns("C").Find(what:="*", searchdirection:=xlPrevious).Row
T_sh2 = Range("C2:D" & Derlig)
'----------------------------------- traitement
For Idx = 1 To UBound(T_sh2)
If Dico.exists(T_sh2(Idx, 1)) Then T_sh2(Idx, 2) = Dico.Item(T_sh2(Idx, 1))
Next
'--------------------------restitution
.Range("C2:D" & Derlig) = T_sh2
.Activate
End With

End Sub

0