Doublons via une comparaison de classeurs

[TIGER]

Bonjour à tous,

Tous le monde connait les difficultés d'élimination de doublon dans des listes d'adresse.
J'ai actuellement des fichiers volumineux à dédoublonner, il faudra faire la manip 3 fois par an !
Je cherche donc à automatiser la manip sous excel.

Problématique :

- la BDD de prospection [BddSuspect] à dédoublonner sur le tel, fax et raison sociale


- la BDD client [BddClient] à comparer à [BddSuspect] et dédoublonner [BddSuspect] sur sur le tel, fax et raison sociale

- la BDD prospect [BddProspect] à comparer à [BddSuspect] et dédoublonner [BddSuspect] sur sur le tel, fax et raison sociale

nb : en sachant que tel et fax peuvent s'écrire : 02/02/02/02/02 ; 02.02.02.02.02 ; 02,02,02,02,02 ou encore 02 02 02 02 02

Merci à tous

 

[Catrice]

Re : Doublons via une comparaison de classeurs

Bonsoir,

Peux tu donner un petit echantillon de ton fichier pour proposer qq chose de concret ?

 

[TIGER]

Re : Doublons via une comparaison de classeurs

Bonjour,

Ci-joint les 3 fichiers :

1/ faire test sur BddSuspect
- des noms de Sté peuvent y être 2 fois mais avec une casse différente, il faudrait mettre le nom en minuscule et comparer avec les autre lignes
- comparer les tel qui peuvent avoir des casses différentes (idem pour les faxs)
2/ Comparer BddSuspect et BddProspect
3/ Comparer BddSuspect et BddClient

Vraiment pas simple (pour mes connaissances) mais je vais essayer de mon côté tout de même.

Merci d'avance,

 

[Catrice]

Re : Doublons via une comparaison de classeurs

Re,

Je n'arrive pas à ouvrir BddProspect.xls.

Tu dis il faut dédoublonner sur le Téléphone, avec BddSuspect par exemple mais on garde laquelle des 2 fiches ?

 

[TIGER]

Re : Doublons via une comparaison de classeurs

oups, désolé il était en xlsx (vs 2007).
Ci-joint le fichier en xls

BddSuspect doit être épuré de tout doublon avec les 2 autres fichiers.
Cad que l'on ne doit pas retrouver dans BddSuspect une fiche existante dans BddProspect ou BddClient.

Merci de votre aide

 

[JCGL]

Re : Doublons via une comparaison de classeurs

Bonjour à tous,

Voici ce que je trouve avec mDFDoublons

Mais je suis pas sur d'avoir tout compris

J'ai regroupé les trois fichiers et appliqué mDFDoublons

Evidement les bases étaient réduites pour l'exemple mais visiblement tu es sous XL 2007. Peut-être pourras-tu tout mettre sur la même feuille ?

A+

 

[Catrice]

Re : Doublons via une comparaison de classeurs

Bonsoir,

Ci-joint le fichier BddSuspect.xls à placer dans le meme dossier que BddClient.xls et BddProspect.xls.
Ouvrir BddSuspect.xls et lancer la macro.
La macro nettoie les formats de N° de Tel et Telecopie et supprime de BddSuspect.xls les fiches qui existent dans BddClient.xls et BddProspect.xls.

 

[TIGER]

Re : Doublons via une comparaison de classeurs

Merci à vous 2 pour votre aide.

@JCGL : mdfDoublons est un excellent outil mais in ne permet malheureusement pas de comparer 2 classeurs ni de comparer des numéros 02 96 87 02 02 et 02/96/87/02/02
@cATRICE : Vraiment excellent ! Tout y est, j'ai remis les 3 classeurs avec des couleurs sur les doublons et j'ai simuler toutes les possibilités : diff casse pour le téléphone et la télécopie, maj et minuscule sur la raison sociale.

Quand on regarde le code, c'est impressionnant, je mattendais à un code bien plus long :

Sub Principal()
MonChemin = ThisWorkbook.Path
Workbooks.Open Filename:=MonChemin & "\BddClient.xls"
Workbooks.Open Filename:=MonChemin & "\BddProspect.xls"
Nettoyeur
SuppDoublon "BddClient.xls", Array(1, 6, 1, 5)
SuppDoublon "BddProspect.xls", Array(1, 6, 7, 1, 6, 7)
End Sub
Sub SuppDoublon(Arg1, Arg2)
For j = 0 To ((UBound(Arg2) + 1) / 2) - 1
    With Workbooks("BddSuspect.xls").Sheets("Feuil1")
        For i = .Range("A65536").End(xlUp).Row To 2 Step -1
            If .Cells(i, Arg2(j)) <> "" Then
                Set C = Workbooks(Arg1).Sheets("Feuil1").Columns(Arg2(j + ((UBound(Arg2) + 1) / 2))).Find(.Cells(i, Arg2(j)))
                If Not C Is Nothing Then .Cells(i, Arg2(j)).EntireRow.Delete
            End If
        Next
    .Activate
    End With
Next
End Sub


Sub Nettoyeur()
MyArray = Array("BddClient.xls", "BddProspect.xls", "BddSuspect.xls")
For i = 0 To UBound(MyArray)
    Windows(MyArray(i)).Activate
    Set D = ActiveSheet.Rows(1).Find("TEL")
    If Not D Is Nothing Then Remplacement Range(Cells(2, D.Column), Cells(65536, D.Column).End(xlUp))
    Set E = ActiveSheet.Rows(1).Find("TELECOPIE")
    If Not E Is Nothing Then Remplacement Range(Cells(2, E.Column), Cells(65536, E.Column).End(xlUp))
Next
End Sub


Sub Remplacement(Arg1)
Arg1.Replace What:=",", Replacement:=""
Arg1.Replace What:="/", Replacement:=""
Arg1.Replace What:=".", Replacement:=""
Arg1.Replace What:=" ", Replacement:=""
Arg1.NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##"
End Sub
Sub Recommencer()
With Workbooks("BddSuspect.xls")
    .Sheets("Copie").Range("A1").CurrentRegion.Copy (.Sheets("Feuil1").Range("A1"))
End With
End Sub

Cependant, j'aime bien comprendre et je ne comprends pas toutes les subtilités de ce code. Pourais-tu expliquer dans les grandes lignes STP ?


J'ajoute en PJ le résultat avec des couleurs sur les lignes doublon pour une meilleure compréhension.


Merci beaucoup et bonne journée

edit : fichiers trop lourd alors j'ai du faire 2 zip. Il faut les mettre dans un seul et même dossier

 

[Catrice]

Re : Doublons via une comparaison de classeurs

Re,

Ci-joint le fichier avec qqs explications.
Si tu as besoin de précisions n'hesite pas.

 

[TIGER]

Re : Doublons via une comparaison de classeurs

Ce code est tout simplement excellent, je connais des gens à qui cela va être très utile !
Merci beaucoup pour les explications et pour ton aide.

A bientôt