Comparer 2 listes de valeurs vba

batousto

XLDnaute Nouveau
Bonjour à toutes, tous,

Je m'adresse à vous car je n'arrive pas à répondre à une problématique vba de comparaison de 2 listes de valeurs.

Je souhaite faire une comparaison entre 2 listes d'id sur deux onglets différents.

Feuil1 : contient une liste id et un code d'export

Feuil2 : contient une liste id

Je souhaite dans Feuil2 voir les valeurs que j'ai en commun avec la liste de la Feuil1

J'ai donc réalisé une macro :

Sub comparaison()
Dim i As Integer
Dim col_2 As Range

'Mise en mémoire id qui sont dans la feuil1
Set col_2 = Worksheets("Feuil1").Range("A2:A7")


'Dans la feuille 2,on identifie les valeurs communes (jaune = valeur absentes)
With ThisWorkbook.Sheets("Feuil2")

For i = 17 To 2 Step -1
'Test si les valeurs correspondent
If Application.CountIf(col_2, .Range("A" & i).Value) = 0 Then
'Si l'id produit n'existe pas on colorie en jaune la ligne
.Rows(i).Interior.Color = vbYellow
End If

'Je souhaite récupérer la valeur code d'export de la feuil1 pour la rajouter devant la bonne ligne avec id commun sur feuil2
'quel code mettre en place

'On passe à la ligne suivante
Next i
End With

Le code fonctionne bien pour la première partie c'est à dire identifier les valeur en communs. Les lignes en jaune ne sont pas en commun.

En revanche je n'arrive pas à récupérer le code d'export pour chaque produit en commun sur la feuil2 (donc à côté des produits non colorés en commun).

Pouvez-vous m'aider pour réaliser cette étape. L'onglet résultat attendu montre ce que je souhaiterai avoir.

Merci par avance

Voici les images du fichier

Feuil1

Feuil1.png

Feuil2

Feuil2.png

Resultats attendus
resultats attendus.jpg
 

Pièces jointes

  • Feuil1.png
    Feuil1.png
    39.7 KB · Affichages: 129
  • Feuil1.png
    Feuil1.png
    39.7 KB · Affichages: 116
  • Feuil2.png
    Feuil2.png
    29.6 KB · Affichages: 112
  • Feuil2.png
    Feuil2.png
    29.6 KB · Affichages: 98
  • exemple.xls
    37 KB · Affichages: 91
  • exemple.xls
    37 KB · Affichages: 78
  • exemple.xls
    37 KB · Affichages: 69

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Comparer 2 listes de valeurs vba

Bonjour,


Code:
  Sub CompareBD()
  Set f1 = Sheets("feuil1")
  Set f2 = Sheets("Feuil2")
  Set a = f1.Range("A2:A" & f1.[a65000].End(xlUp).Row)
  Set b = f2.Range("a2:a" & f2.[a65000].End(xlUp).Row)
  b.Resize(, 2).Interior.ColorIndex = xlNone
  a.Resize(, 2).Interior.ColorIndex = xlNone
  Set d1 = CreateObject("Scripting.Dictionary")
  For Each c In a
    d1(c.Value) = c.Offset(, 1).Value
  Next c
  For Each c In b
    If Not d1.exists(c.Value) Then   c.Resize(, 2).Interior.ColorIndex = 6  Else   c.Offset(, 1) = d1.Item(c.Value)
  Next c
End Sub

CompareBD.gif

JB
 

Pièces jointes

  • Exemple-1.xls
    42.5 KB · Affichages: 97
  • Exemple-1.xls
    42.5 KB · Affichages: 91
  • Exemple-1.xls
    42.5 KB · Affichages: 115
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Comparer 2 listes de valeurs vba

Bonjour.

Cette procédure sans boucle dans le module Feuil3 (Feuil2) :
VB:
Option Explicit

Private Sub Worksheet_Activate()
Dim PlgSrc As Range, PlgCbl As Range
Set PlgSrc = Feuil1.[A2:B2].Resize(Feuil1.[A60000].End(xlUp).Row - 1)
Set PlgCbl = Me.[A2:B2].Resize(Me.[A60000].End(xlUp).Row - 1)
With PlgCbl.Columns(2)
   .FormulaR1C1 = "=INDEX(" & PlgSrc.Columns(2).Address(True, True, xlR1C1, True) _
      & ",MATCH(RC1," & PlgSrc.Columns(1).Address(True, True, xlR1C1, True) & ",0))"
   .Value = .Value: End With
PlgCbl.Interior.ColorIndex = xlNone
Set PlgCbl = CellsColCondR1C1(PlgCbl, "ISNA(RC2)")
PlgCbl.Interior.ColorIndex = 6
Intersect(Me.Columns(2), PlgCbl).ClearContents
End Sub

Function CellsColLgnOù(ByVal CelDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Set CellsColLgnOù = Intersect(LignesOù(CelDéb, ColQuoi, Opé, Valeur), CelDéb.EntireColumn)
End Function
Function LignesOù(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
   """", """""") & """" Else Valeur = Trim$(Str$(Valeur))
Set LignesOù = LignesOùCondR1C1(LigneDéb, "RC" & ColQuoi & Opé & Valeur)
End Function
Function CellsColCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Set CellsColCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
End Function
Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Dim Lignes As Range, ColTrv As Range
With LigneDéb.Worksheet.UsedRange
   Set Lignes = LigneDéb.EntireRow.Resize(.Rows.Count + .Row - LigneDéb.Row)
   Set ColTrv = Intersect(.Columns(.Columns.Count + 1), Lignes): End With
ColTrv.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
On Error Resume Next
Set LignesOùCondR1C1 = ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow
ColTrv.Delete xlShiftToLeft
End Function
Remarque: vous devriez harmoniser les noms des objets Worksheet de la rubrique Microsoft Excel Objets avec les noms des feuilles Excel qu'ils représentent.
 
Dernière édition:

batousto

XLDnaute Nouveau
Re : Comparer 2 listes de valeurs vba

Bonjour JB,

Merci pour votre réponse rapide, le fichier exemple est nickel. J'ai en revanche une petite question, la macro fonctionne parfaitement avec des id au format numérique exclusif. Pour vous expliquer les deux listes que je dois comparer contiennent chacune + de 10000 produits. Les id sont pour certains numériques et pour d'autres alpha numerique. Avec la macro, seuls les id au format numérique sont comparés. Y-aurait il la possibilité de mettre mes listes id "format texte" et de faire la même comparaison ?

Exemple d'id : 2601255
201546E00 (ces nombres me posent pb car ca se transforme en 20145E+0)

Qu'en pensez-vous ?

Merci d'avance

Bruce
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 978
Membres
101 854
dernier inscrit
micmag26