Supprimer les valeurs uniques

Bonjour à tous,

Je souhaiterai obtenir votre aide.

Je vais essayer de vous expliquer le plus clairement et le plus succinctement possible mon problème.

J'ai un classeur excel ouvert avec dedans deux colonnes A et B contenant des références de produits. Les deux colonnes sont de tailles très différentes l'une contient plus de 5000 lignes et seulement 400 pour l'autre.

Et il se trouve que ces deux colonnes possèdent des références communes, en effet certaines références sont présentes dans les deux colonnes et ce sont ces références que je veux garder. C'est pourquoi j'ai appeler le sujet "Supprimer les valeurs uniques". Je veux en fait garder les références qui sont présentent dans les deux colonnes à la fois.

Merci de tout aide que vous pourrez m'apporter étant débutant en excel toute proposition me fera plaisir !

Cordialement

Ps: Je ne peux pas vous envoyer le fichier excel

Babz a écrit :

Ps: Je ne peux pas vous envoyer le fichier excel

Bonjour,

Ha bon ?

et même pas une copie strictement identique , anonymisée et de 50 lignes ? ? ?

P.

Bonjour,

En effet j'ai peut être légèrement exagérer la situation !

Ci-joint l'échantillon

Merci de cette première réponse.

Parfait...

il n'y a aucun doublon dans les 2 colonnes

J'en ai crée des fictifs e tu verras le résultat

P.

[quote="patrick1957"]J'en ai crée des fictifs e tu verras le résultat

Oui effectivement il y en à peu et ils sont répartis sur les 5000 lignes ahah.

Merci beaucoup pour ton aide, aurais tu une astuce pour ouvrir le lien car à chaque fois que je clique dessus une fenêtre "WatchGuard" s'affiche pour me dire que je ne peux pas ouvrir ce lien.

Merci beaucoup d'avoir pris le temps de m'aider.

De quel lien parles tu ?

Tu veux adapter le code à ton fichier réel ?

Si oui, il faut copie du code VBA dans un module ALT F11 / Insertion/module et puis sauver ton fichier en xlsm ...

Ça répond à ta question ?

P

Non pas du tout, je parlai de la pièce jointe je n'arrive pas à l'ouvrir, pardonne moi quand on a quelque chose en tête on ne se rend pas compte que les autres ne sont pas dans notre tête.

Voilà les 2 codes, que tu affectes à un objet sur la feuile, tu saves en xlsm et ça ira :

' comparer colonne A et B et remettre en E les données Uniques donc sans doublon !!
' pmk 2015

Sub UniqColonneE() ' 1er code
Dim r As Range, dico As Object, x, A, b, i&, S  ' déclaration des variables OK
Set dico = CreateObject("Scripting.Dictionary")
Set Ws1 = Sheets("Feuil1")
LastrowA = Range("A65000").End(xlUp).Row
lastrowb = Range("B65000").End(xlUp).Row
plus = IIf(LastrowA < lastrowb, lastrowb, LastrowA)
Set r = Range("A1:B" & plus) ' ws1.[A65000].End(xlUp).Row)
For Each r In r  ' pour chaque cellule dans le range "r"
  If r <> "" Then
  x = r  ' ? scalaire plus rapide, évite de répéter r.Value
    If Not dico.Exists(x) Then  '
      dico(x) = dico(x) & r.Offset(, 1)
    End If
  End If
Next
'---restitution en colonne E---
Application.ScreenUpdating = False  ' OK
Range("E2:E" & Rows.Count).Clear  ' OK
If dico.Count = 0 Then Exit Sub  ' si vide on sort OK
A = dico.Keys
b = dico.Items
For i = 0 To UBound(A)  ' boucle de 0 à nombre d'occurences les "array" commencent toujours à 0
  Cells(i + 1, 5) = A(i)
Next
Columns(5).AutoFit
End Sub

Sub RepérerDoublons() 'JB 2e code
'Repérage des doublons entre 2 colonnes
  Set D1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  Set Plage1 = Range("A1", [A65000].End(xlUp))
  Set plage2 = Range("B1", [B65000].End(xlUp))
  [A:B].Interior.ColorIndex = xlNone
  For Each C In Plage1
    If C <> "" Then D1(C.Value) = ""
  Next C
  For Each C In plage2
    If D1.Exists(C.Value) Then C.Interior.ColorIndex = 3
    If C <> "" Then d2(C.Value) = ""
  Next C
  For Each C In Plage1
    If d2.Exists(C.Value) Then C.Interior.ColorIndex = 4
  Next C
End Sub

Merci, je dois dire que c'est plutôt impressionnant et très agréable de voir que des personnes sont prêtes à donner de leur temps de cette façon. Le code marche très bien et me convient parfaitement, merci beaucoup de ton aide et je te souhaite une très bonne fin de journée.

Cordialement