extraire les cellules uniques de 2 listes

[fab032]

extraire les cellules uniques d'une liste par rapport à une autre

Bonjour,
je fais appel à vous car j'ai un problème. J'ai 2 listes contenants des mails L1 et L2 et j'aimerais créer une 3ème liste avec les e-mails de L2 qui ne sont pas présents dans L1.
Je ne sais pas si je suis très clair. j'ai commencé un petit fichier de test, que je joins.
Si quelqu'un pouvait m'aider, je lui serais très reconnaissant !
Merci
fab032

 

[Excel-lent]

Re : extraire les cellules uniques d'une liste par rapport à une autre

Bonjour et bienvenu sur le forum Fab032,

Tu peux par exemple utiliser la fonction NB.SI(), ce qui en language VBA s'écrit COUNTIF.

Voici ci-dessous une solution avec COUNTIF
(testé sur ton fichier - elle fonctionne)

Sub Macro1()
' Macro enregistrée par Excel-lent

Dim NbLigneNouvoProspects As Long
Dim NbLigneL2 As Long

NbLigneNouvoProspects = [F65536].End(xlUp).Row
NbLigneL2 = [D65536].End(xlUp).Row
    
For j = 2 To NbLigneNouvoProspects
   If Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(NbLigneL2, 4)), Cells(j, 6)) = 0 Then
        Range("H" & [H65536].End(xlUp).Row + 1) = Range("F" & j)
   End If
Next j

End Sub

Si besoin d'explication(s) plus détaillée(s) n'hésite pas.

Évidement si tu le souhaite tu peux rajouter au début de la macro :
Application.ScreenUpdating = False

Et à la fin :
Application.ScreenUpdating = True

Bon grand WE

 

[ROGER2327]

Re : extraire les cellules uniques de 2 listes

Bonjour fab032

Procédure complétée pour remplir aussi la colonne H :

Sub ExtraitDoublons()
Dim Plg As Variant, Item As Variant, SansDoublon As Variant
Dim Plg2 As Variant, Col2 As Collection, Nouveau As Variant [COLOR="SeaGreen"]'*[/COLOR]
Dim Col As Collection
Dim I As Integer 'Long
   Application.ScreenUpdating = False
   With Sheets("Prospects")
      Plg = .Range("B2:B" & .Range("B65536").End(xlUp).Row)
   End With
   Set Col = New Collection
   For I = 1 To UBound(Plg, 1)
      On Error Resume Next
      Col.Add Plg(I, 1), CStr(Plg(I, 1))
      On Error GoTo 0
   Next I
   ReDim SansDoublon(1 To Col.Count, 1 To 1)
   I = 0
   For Each Item In Col
      I = I + 1
      SansDoublon(I, 1) = Item
   Next Item
   With Sheets("Prospects") [COLOR="SeaGreen"]'*[/COLOR]
      Plg2 = .Range("F2:F" & .Range("F65536").End(xlUp).Row) [COLOR="SeaGreen"]'*[/COLOR]
   End With [COLOR="SeaGreen"]'*[/COLOR]
   Set Col2 = New Collection [COLOR="SeaGreen"]'*[/COLOR]
   For I = 1 To UBound(Plg, 1) [COLOR="SeaGreen"]'*[/COLOR]
      On Error Resume Next [COLOR="SeaGreen"]'*[/COLOR]
      Col2.Add Plg2(I, 1), CStr(Plg2(I, 1)) [COLOR="SeaGreen"]'*[/COLOR]
      On Error GoTo 0 [COLOR="SeaGreen"]'*[/COLOR]
   Next I [COLOR="SeaGreen"]'*[/COLOR]
   For Each Item In Col [COLOR="SeaGreen"]'*[/COLOR]
      On Error Resume Next [COLOR="SeaGreen"]'*[/COLOR]
      Col2.Remove Item  [COLOR="SeaGreen"]'*[/COLOR]
      On Error GoTo 0 [COLOR="SeaGreen"]'*[/COLOR]
   Next Item [COLOR="SeaGreen"]'*[/COLOR]
   Set Col = Nothing
   ReDim Nouveau(1 To Col2.Count, 1 To 1) [COLOR="SeaGreen"]'*[/COLOR]
   I = 0 [COLOR="SeaGreen"]'*[/COLOR]
   For Each Item In Col2 [COLOR="SeaGreen"]'*[/COLOR]
      If Not IsEmpty(Item) Then I = I + 1: Nouveau(I, 1) = Item [COLOR="SeaGreen"]'*[/COLOR]
   Next Item [COLOR="SeaGreen"]'*[/COLOR]
   Set Col2 = Nothing [COLOR="SeaGreen"]'*[/COLOR]
   With Sheets("Prospects")
      .Range("D2").Resize(UBound(SansDoublon, 1), UBound(SansDoublon, 2)) = SansDoublon
   End With
   With Sheets("Prospects") [COLOR="SeaGreen"]'*[/COLOR]
      .Range("H2").Resize(UBound(Nouveau, 1), UBound(Nouveau, 2)) = Nouveau [COLOR="SeaGreen"]'*[/COLOR]
   End With [COLOR="SeaGreen"]'*[/COLOR]
   Application.ScreenUpdating = True
End Sub

Les lignes ajoutées sont marquées '*.​

ROGER2327

 

[fab032]

Re : extraire les cellules uniques de 2 listes

Génial ! Merci !!!
est-il possible aussi de vider les liste L2 et L4 au début du traitement de la macro ? (car problème si on insère par mégarde un mail dans L2 ou L4, il reste)
Encore une question : est-il possible, toujours en appuyant sur le bouton "éliminer les doublons" de colorer :
- les doublons dans L1
- les cellules de L3 qui sont présentes dans L2

Merci beaucoup !

 

[ROGER2327]

Re : extraire les cellules uniques de 2 listes

Bonjour fab032

Quelques retouches dans le classeur joint :

1. Vidage des listes L2 et L3-L2 (=L4 ?)
2. Dim I As Long au lieu de Dim I As Integer pour le cas où les listes deviendraient très longues.
3. Pour ce qui est des coloriages de cellules, j'ai réglé ça par une mise en forme conditionnelle (on peut le faire dans le code, mais je n'ai pas le temps maintenant).
4. Modification du bouton : propriété TakeFocusOnClick à False.

Voyez si cela vous convient.​

ROGER2327
Et maintenant, en route pour la manif !