Supprimer Des Doublons

  • Initiateur de la discussion Initiateur de la discussion JeEbZzZz
  • Date de début Date de début

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 !

J

JeEbZzZz

Guest
Bonjour,

j'ai une base de contacts dans lesquels je retrouve des doublons.
Comment faire pour les supprimer rapidement et ainsi avor une base "propre"?

Ces bases sont assez longues, je peut repérer les doublons grâce à un TCD mais supprimer tous les doublons à la main prendrait énormément de temps...

Merci de votre aide!
 

Pièces jointes

Re : Supprimer Des Doublons

Bonjour JeEbZzZz,

Dans un premier temps tu tries les noms par ordre alphabétique
Dans la cellule H2 : =si(b2=b1;"doublon";"ok")
tu recopies cette formule vers le bas
tu vas dans outil filtre filtre automatique
tu sélectionnes "doublon"
tu les supprimes
tu annules le filtre
tu sélectionnes tous ton tableau et tu le tries de nouveau
 
Re : Supprimer Des Doublons

Bonjour JeEbZzZz, GPLIONEL et le forum,

Essayes la macro suivante. Le nom de la feuille doit être adapté.

Sub FiltrerTrierA()
Dim Tablo, i As Integer, j As Integer, k As Byte, Plage As Range

Application.ScreenUpdating = False
With Sheets("Feuil1")
Set Plage = .Range("A2:G" & .Range("A65536").End(xlUp).Row)
' Définition du tableau
Tablo = Plage
'Elimination des lignes en doublons
For i = 1 To UBound(Tablo) - 1
If Tablo(i, 3) <> "" Then
For j = i + 1 To UBound(Tablo)
If Tablo(j, 3) <> "" And Tablo(j, 3) = Tablo(i, 3) Then
For k = 1 To 7
Tablo(j, k) = ""
Next k
End If
Next j
End If
Next i
Plage = Tablo
Plage.Sort Key1:=Range("B2"), Order1:=xlAscending
End With
End Sub

Cordialement

Bernard
 
Dernière édition:
Re : Supprimer Des Doublons

Bonjour Lionel

Merci de la réponse, mais ça marche uniquement si le doublon apparaît à la ligne du dessous, or le même nom peut appararaître n'importe où dans le fichier.

Merci de ton aide
 
Re : Supprimer Des Doublons

bonjour

un code à essayer (je considere la ligne entiere pour détecter les doublons) :

Code:
Sub Bouton1_QuandClic()
Dim col As Byte
Dim i As Long
Dim j As Byte
Dim plage As Range
Dim ligne As Integer

Application.ScreenUpdating = False

ligne = Range("a65536").End(xlUp).Row
col = Range("iv1").End(xlToLeft).Column + 1

For i = 2 To ligne
    For j = 1 To col - 1
        Cells(i, col) = Cells(i, col) & Cells(i, j)
    Next j
Next i

Set plage = Range(Cells(2, col), Cells(ligne, col))

For i = ligne To 2 Step -1
    If Application.CountIf(plage, Cells(i, col)) > 1 Then
        Rows(i).Delete
    End If
Next i

Columns(col).Delete
Application.ScreenUpdating = True
    
End Sub

salut
 
Re : Supprimer Des Doublons

re

juste sur le nom :

Code:
Sub Bouton2_QuandClic()
Dim plage As Range
Dim i As Integer

Set plage = Range("b2:b" & Range("b65536").End(xlUp).Row)

For i = Range("b65536").End(xlUp).Row To 2 Step -1
    If Application.CountIf(plage, Cells(i, 2)) > 1 Then
        Rows(i).Delete
    End If
Next i

End Sub

salut
 
Re : Supprimer Des Doublons

une autre via une collection
en fait sur prénom nom il faudrait au préalable supprimer les espaces surnuméraires dans la chaine, les espaces insécables et les espaces de debut et fin etc
 

Pièces jointes

Dernière édition:
Re : Supprimer Des Doublons

bonjour a tous

ma version:

Code:
Option Explicit
Sub test()
Dim n As Integer
Dim nodoublons As Collection
Set nodoublons = New Collection
Dim doublons As Collection
Set doublons = New Collection
For n = 2 To Range("B65536").End(xlUp).Row
On Error Resume Next
nodoublons.Add Range("B" & n), CStr(Range("B" & n))
 If Err.Number <> 0 Then doublons.Add n
On Error GoTo 0
Next n
For n = doublons.Count To 1 Step -1
  Rows(doublons(n)).Delete
Next n
End Sub
 
Re : Supprimer Des Doublons

dans Classeur1_Mod : Modifier la clef Prénom Nom par nouvelle clef Prénom Nom Adresse
remplacer Coll.Add Cell, CStr(Cell)
par Coll.Add Cell, CStr(Cell) & CStr(Cell.Offset(0, 3))
 
Dernière édition:
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
17
Affichages
784
Réponses
2
Affichages
531
Réponses
1
Affichages
373
Réponses
10
Affichages
641
Réponses
2
Affichages
266
Réponses
5
Affichages
245
Réponses
33
Affichages
1 K
Retour