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

mc13009 · 27 Octobre 2020

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 !

job75 · 27 Octobre 2020

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+

job75 · 27 Octobre 2020

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

job75 · 27 Octobre 2020

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.

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

mc13009

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires