Comparer tableau vba
GenieIngenieur
Messages postés
18
Statut
Membre
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
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 ^^
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
-
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
