Doublon ou fusion

Bonjour,

après avoir regardé les sujets existants sur les doublons, je ne crois pas avoir vu la réponse à ma recherche (ou je n'ai pas compris ce que je lisais, ce qui est possible^^).

Mon entreprise m'a transmis une liste de clients à recontacter, format excel, environ 17000 lignes. Il y a dedans énormément de doublons ou de triplets. Les clients sont enregistrés parfois sous leur nom, ou celui de leur entreprise, avec un ou plusieurs numéros de téléphone. Pour ne pas devoir vérifier à chaque fois si j'ai déjà appelé, je voudrais avant tout faire le ménage dans le fichier. Dans l'idéal, j'aimerais me retrouver au final avec, par client, une seule ligne ayant : nom ou société, tél fixe, tel portable. J'ai mis sur le fichier joint l'exemple le plus fréquent. Je ne sais pas comment m'y prendre, et J'ai peur de faire une fausse manip, et de "perdre" complètement des coordonnées clients...

Si je fais une mise en forme conditionnelle, ça m'affichera les cellules en double, mais je devrai supprimer une par une ?

Si j'utilise "supprimer les doublons", comment dois-je faire ? Je me disais qu'il y avait peut-être aussi quelque chose à faire en fusionnant les contenus.

J'espère avoir été suffisamment clair, merci à vous si vous pouvez me renseigner.

10test-doublon.xlsx (9.23 Ko)

Bonjour,

Bah si t'as peur de perdre des infos le mieux c'est de tout copié dans un onglet "archive", et de supprimer tes données (avec l'option supprimer les doublons) dans ton onglet de travail

Pour supprimer des doublons tu sélection toutes les ligne / colonne qui contiennes des éléments potentiellement supprimable, ensuite tu clique sur supprimer les doublons, et là il te demande quel critère tu veux qu'il vérifie, tu sélectionne juste la colonne nom du client ou bien pour être bien sur, le nom ET n° de téléphone, si c'est deux occurrence se retrouve sur 2 ligne distincte il en supprimera 1

Bonjour,

Il faut que tu saches ce qu'est exactement le doublon dans ton exemple..

Dans les 3 lignes que tu présentes, il n'y en a aucun si on prends l'ensemble des 5 colonnes d'un même enregistrement

Par contre, si tu considères uniquement "prénom et adresse" il y a des doublons oui

Ton exemple n'est pas très significatif; il en faudrait 20 à 30 lignes du vrai fichier où tu changes ce qui te semble être privé par des données exemples mais réalistes

P.

Re,

Je me demande si dans ton cas tu ne préférerais pas tout garder, si des lignes ont été rajouté c'est surement qu'il y a eut un changement d'adresse / de n° de téléphone voir un ajout ( multiplicité ), est-ce que en triant par nom de client avec un filtre et une MFC pour la clarté ça ne serais pas mieux ? Comme ça en prime si jamais tu trouve un n° obsolète t'es pas obligé d'aller en chercher un autre il est directement en dessous

cf fichier joint .

A voir .

8test-doublon.xlsx (11.60 Ko)

Bonjour,

merci pour vos réponses, et je vous prie de m'excuser pour ne pas avoir pu répondre avant. Je vous joins un bout de fichier, qui sera, je l'espère, plus clair que mes explications. Les numéros de tél ont tous été changés pour respecter l'anonymat.

Dans l'idéal, j'aimerais me retrouver avec un nom de client et/ou de société, et les numéros correspondant, sans avoir de doubles. Même si dans le tri je perds un des deux noms (client ou société), ça n'est pas bien grave tant que je ne perds aucun numéro. Ce sont surtout des EURL, il n'y a qu'un ou deux interlocuteurs possibles.

Sinon, la solution de Wafewmark (merci pour l'exemple) sera toujours envisageable.

15doublons.xlsx (13.31 Ko)

Bonsoir à tous,

Essaie ceci :

Option Explicit
Sub test()
Dim a, b(), w(), i As Long, j As Long, n As Long, txt As String
Const col As Byte = 2
    ReDim w(1 To 2)
    With Sheets("test").Range("a1").CurrentRegion
        a = .Value: n = 1
        ReDim b(1 To UBound(a, 1), 1 To col + 1)
        For j = 1 To col + 1
            b(n, j) = a(n, j)
        Next
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If IsEmpty(a(i, 1)) Then txt = a(i, 2) Else txt = a(i, 1)
                If Not .exists(txt) Then
                    n = n + 1
                    w(1) = n
                    Set w(2) = CreateObject("Scripting.Dictionary")
                    w(2).CompareMode = 1
                    For j = 1 To col
                        b(n, j) = a(i, j)
                    Next
                Else
                    w = .Item(txt)
                End If
                For j = col + 1 To UBound(a, 2)
                    If Not IsEmpty(a(i, j)) Then
                        If Not w(2).exists(a(i, j)) Then
                            w(2)(a(i, j)) = Empty
                            If UBound(b, 2) < col + w(2).Count Then
                                ReDim Preserve b(1 To UBound(b, 1), 1 To UBound(b, 2) + 1)
                            End If
                            b(w(1), col + w(2).Count) = a(i, j)
                        End If
                    End If
                Next
                .Item(txt) = w
            Next
        End With
    End With
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Range("a1").Resize(n, UBound(b, 2))
        .CurrentRegion.Clear
        .Value = b
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        With .Rows(1)
            .Font.Size = 11
            .Interior.ColorIndex = 38
            .BorderAround Weight:=xlThin
            .HorizontalAlignment = xlCenter
        End With
        If UBound(b, 2) > 3 Then
            With .Offset(, 2).Resize(1, 1)
                .AutoFill .Resize(, UBound(b, 2) - 2)
            End With
        End If
        .Columns.ColumnWidth = 13
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Klin89, merci pour la macro. J'ai voulu la lancer, mais ça me dit : "l'indice n'appartient pas à la sélection", et le bouton de déboguage me signale la ligne suivante :

With Sheets("Feuil1").Range("a1").Resize(n, UBound(b, 2))

Et je suis bien incapable de décrypter ça Est-ce qu'il ne faudrait pas que ça commence en a2, comme la première ligne est un en-tête ?

Louismarc a écrit :

Bonjour,

With Sheets("Feuil1").Range("a1").Resize(n, UBound(b, 2))

Tu n'as pas de "feuil1" ajoute donc un onglet ...

P.

Hello à Klin :

Merci, en copiant dans un onglet "Feuil1", ça marche presque. Ca fonctionne avec le fichier de test, mais pas avec le "vrai" fichier. Je pense avoir compris pourquoi, et je suis un boulet...

En pensant simplifier, j'avais mis en exemple un tableau où il n'y avait pas toutes les colonnes du tableau d'origine, mais seulement celles qui me semblaient pertinentes pour ma demande d'aide. Et je crois que c'est ça qui met le bazar.

Dans le tableau d'origine, il y a "Société;Nom;Adresse;Code Postal;Ville;Tél 1;Tél 2;Tél 3;E-mail;Age", et j'avais enlevé tout ce qui concerne l'adresse, mail, et age...

J'ai modifié le fichier d'exemple joint, conforme au fichier final. Si vous pouvez prendre un peu de temps pour modifier la macro par rapport à ça, merci d'avance

Bon dimanche

8doublons.xlsm (27.73 Ko)

Re Louismarc,

Pour faire simple, on peut effacer les doublons en colonnes F,G et H

Option Explicit
Sub test()
Dim dico As Object, r As Range, derlig As Long, t As Long, txt As String
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    derlig = Sheets("test").Range("d" & Rows.Count).End(xlUp).Row
    For Each r In Sheets("test").Range("a2:a" & derlig)
        If Not IsEmpty(r.Value) Then txt = r.Value Else txt = r(, 2).Value
        If Not dico.exists(txt) Then
            Set dico(txt) = CreateObject("Scripting.Dictionary")
        End If
        For t = 6 To 8
            If r(, t).Value <> "" Then
                If Not dico(txt).exists(r(, t).Value) Then
                    dico(txt)(r(, t).Value) = Empty
                Else
                    'r(, t).ClearContents 'efface les doublons
                    r(, t).Font.Size = 14
                    r(, t).Font.Bold = True
                End If
            End If
        Next
    Next
End Sub

klin89

Bonsoir,

cette fois c'est bon, avec ces deux macros, ça fait le ménage Merci pour votre aide, tout particulièrement à Klin89.

Rechercher des sujets similaires à "doublon fusion"