Microsoft 365 Meilleure solution pour comparer et supprimer doublon 2 fichiers Excel

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

mc13009

XLDnaute Nouveau
Bonjour à tous,

Tout d’abord merci a tous ceux qui prendront le temps de répondre.
j’ai fait quelques recherches mais je ne trouve pas mon bonheur.

voilà ma demande:
j’ai un fichier source avec 2 colonnes, la A pour les codes postaux et la B pour des adresses emails
j’ai un autre fichier avec une seule colonne qui contient des adresses emails. Il s’agit de demande de desinscription, donc ces adresses sont en doublon par rapport au premier fichier.

=> j’ai donc besoin de supprimer les adresses emails du premier fichier source présent dans le second fichier.

ayant besoin de reproduire régulièrement cette manipulation, je cherche la solution la plus simple.
une simple recherche de doublon est casse-pieds, car il faut supprimer les 2 (pas uniquement les doublons)


d’avance merci !
 
Bonjour mc13009, bienvenue sur XLD,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Cliquez sur le bouton pour exécuter cette macro :
VB:
Sub Desinscrire()
Dim fichier$, tablo, d As Object, i&
fichier = ThisWorkbook.Path & "\Désinscrire.xlsx"
If Dir(fichier) = "" Then MsgBox fichier & " introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
'---liste des emails à supprimer---
Workbooks.Open fichier
tablo = [A1].CurrentRegion 'matrice, plus rapide
ActiveWorkbook.Close False
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---suppressions---
With [A1].CurrentRegion
    For i = 1 To .Rows.Count
        If d.exists(.Cells(i, 2).Value) Then .Cells(i, 2) = ""
    Next
End With
End Sub
La suppression cellule par cellule est la meilleure solution puisque la colonne B contient des liens.

A+
 

Pièces jointes

Dernière édition:
En fait s'agissant simplement d'effacements on peut utiliser un tableau VBA, fichier (2) :
VB:
Sub Desinscrire()
Dim fichier$, tablo, d As Object, i&
fichier = ThisWorkbook.Path & "\Désinscrire.xlsx"
If Dir(fichier) = "" Then MsgBox fichier & " introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
'---liste des emails à supprimer---
Workbooks.Open fichier
tablo = [A1].CurrentRegion 'matrice, plus rapide
ActiveWorkbook.Close False
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---suppressions---
With [A1].CurrentRegion
    tablo = .Resize(, 2) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 2)) Then tablo(i, 2) = ""
    Next
    .Value = tablo 'restitution
End With
End Sub
C'est bien plus rapide, pour tester j'ai recopié la plage A2:B5 sur 10 000 lignes :

- fichier (1) => 1,9 seconde

- fichier (2) => 0,17 seconde
 

Pièces jointes

Maintenant si l'on veut supprimer les lignes entières utiliser cette macro, fichier (3) :
VB:
Sub Desinscrire()
Dim fichier$, tablo, d As Object, i&
fichier = ThisWorkbook.Path & "\Désinscrire.xlsx"
If Dir(fichier) = "" Then MsgBox fichier & " introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
'---liste des emails à supprimer---
Workbooks.Open fichier
tablo = [A1].CurrentRegion 'matrice, plus rapide
ActiveWorkbook.Close False
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---suppressions---
With [A1].CurrentRegion
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    tablo = .Resize(, 2) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 2)) Then tablo(i, 2) = ""
    Next
    .Value = tablo 'restitution
    .Columns(2).Insert xlToRight 'colonne auxiliaire
    .Columns(2) = "=1/ISBLANK(RC[1])"
    .Columns(2) = .Columns(2).Value 'supprime les formules
    .Sort .Columns(2), xlAscending 'tri pour grouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.Columns(2).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp 'supprime les nombres en colonne B
    .Columns(2).Delete xlToLeft 'supprime la colonne auxiliaire
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub
Avec le tableau de 10 000 lignes 5 000 lignes sont supprimées en 0,45 seconde chez moi.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour