Supprimer les doublons dans un tableau?

Bonjour
ci joint un fichier d'un celebre mvp
Bon courage [file name=doublons_20051102060633.zip size=15857]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/doublons_20051102060633.zip[/file]

Merci Flyonets pour ta réponse rapide!
Mais je viens de tester cette macro sur les doublons en Col A ,B et D...ça ne marche pas...j'ai une erreur!!!
J'ai un X= Erreur 2029 et ensuite donc 'Incompatibilité de Type'
Je ne vois pas où est le problème???
Je l'ai mis en fichier joint!

:unsure: 🙁 [file name=RechDoublons2.zip size=8580]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/RechDoublons2.zip[/file]

Bonsoir alol.ita, Flyonets,

Tu peux également, si tu le souhaites, essayer la macro complémentaire que j'avais faite justement pour ça.

Ci-joint la version 3.2 de cet utilitaire pour détecter, supprimer et/ou archiver les doublons (multicolonnes) de ton fichier :



Après avoir lancé ce fichier, un nouveau bouton 'Doublons' apparaît dans ta barre d'outils Excel. Tu cliques dessus.
Dans la liste des colonnes qui s'affiche, tu sélectionnes A, B, D et E, tu coches ensuite 'Archivage doublons' (si tu souhaites en garder une trace), puis tu valides par le bouton 'Supprimer Doublons'.


Pour les utilisations futures, tu auras 2 façons de faire à ta disposition :

1) La première est de lancer le fichier ponctuellement, tu l'ouvriras donc dans Excel (comme n'importe quel classeur 'classique') lorque tu en auras besoin.

2) La deuxième consiste à le faire charger automatiquement à chaque démarrage d'Excel pour l'avoir ainsi tout le temps à disposition :
- Tu enregistres ce fichier '.xla' dans ton répertoire de Macros Complémentaires
- Tu lances Excel, puis tu fais Outils/Macros Complémentaires
- Tu coches 'mDF_Doublons', puis OK.

Dans les 2 cas, un nouveau bouton intitulé 'Doublons' apparaît maintenant dans la barre d'outils Excel. Un clic dessus et le traitement de la feuille active peut commencer...


Cordialement,

[file name=mDF_Doublons32.zip size=18143]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/mDF_Doublons32.zip[/file]

J'ai testé cette macro complémentaire qui fonctionne bien pour mon cas...mais j'aimerais l'inclure dans ma macro...et je ne sais pas comment faire...
Par contre j'ai trouvé sur le site de frederic.sigonneau
Ce site n'existe plus
une macro qui convient bien à mon cas de doublons sur plusieurs colonnes
'Recherche de doublons multi-colonnes avec correspondance multi-critères'...mais en fait j'aimerais supprimer les lignes des doublons
et non les archiver sur une feuille.
Merci
[file name=Doublons_20051103143009.zip size=12054]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Doublons_20051103143009.zip[/file]

Message édité par: alol.ita, à: 05/11/2005 01:52

En fait il faut changer 2 valeurs booléennes
DeleteDuplicates = True ' donc suppression des lignes
WriteListOfDuplicates = False 'pas d'archives des doublons en feuil4.

Sub doublons()

Dim CheckRows As Range
Dim ColumnsToMatch As Variant
Dim DeleteDuplicates As Boolean
Dim FormatDuplicates As Boolean
Dim WriteListOfDuplicates As Boolean
Dim AddRowNumberToList As Boolean
Dim lLBound As Long
Dim lUBound As Long
Dim CheckRange As Range
Dim SubArray As Variant
Dim FieldsCollection As New Collection
Dim RowNumberCollection As New Collection
Dim Dummy As Long
Dim DuplicateRange As Range
Dim DuplicatesExist As Boolean
Dim lRow As Long
Dim CollectionKey As String
Dim OffsetValue() As Long
Dim StartCell As Range
Dim Element As Variant
Dim Counter As Long

'adapter les 6 variables ci-dessous pour mettre à jour
'les paramètres de travail de la macro
Set CheckRows = Rows('1:1000')
ColumnsToMatch = Array('A', 'B', 'D')
DeleteDuplicates = True
FormatDuplicates = False
WriteListOfDuplicates = False
AddRowNumberToList = True


lLBound = LBound(ColumnsToMatch)
lUBound = UBound(ColumnsToMatch)

Set CheckRange = Intersect(Range(ColumnsToMatch(lLBound) & _
':' & ColumnsToMatch(lLBound)), CheckRows)

ReDim OffsetValue(lUBound - lLBound + 1)

For Counter = lLBound To lUBound
OffsetValue(Counter) = Range(ColumnsToMatch(Counter) & ':' & _
ColumnsToMatch(Counter)).Column - CheckRange.Column
Next Counter

On Error Resume Next
SubArray = CheckRange.Value
For lRow = 1 To UBound(SubArray, 1)
If SubArray(lRow, 1) <> '' Then
CollectionKey = ''
For Counter = lLBound To lUBound
CollectionKey = CollectionKey & _
CheckRange(lRow, 1).Offset(0, _
OffsetValue(Counter)).Value
Next Counter
FieldsCollection.Add Dummy, CStr(CollectionKey)
If Err.Number = 457 Then
Err.Clear
DuplicatesExist = True
RowNumberCollection.Add CheckRange(lRow, 1).Row
If DuplicateRange Is Nothing Then
Set DuplicateRange = _
CheckRange.Cells(lRow, 1)
Else
Set DuplicateRange = Union(DuplicateRange, _
CheckRange.Cells(lRow, 1))
End If
End If
End If
Next lRow
On Error GoTo 0

If DuplicatesExist = False Then
MsgBox 'No duplicates exist.', vbInformation
Else
With DuplicateRange.EntireRow
If WriteListOfDuplicates Then
Worksheets.Add After:=DuplicateRange.Parent
.Copy Destination:=Range('A1')
If AddRowNumberToList Then
Columns('A').Insert
Set StartCell = Range('A1')
For Each Element In RowNumberCollection
StartCell.Value = 'Row ' & Element
Set StartCell = StartCell.Offset(1, 0)
Next Element
End If
End If
If FormatDuplicates Then .Font.ColorIndex = 3
If DeleteDuplicates Then .Delete
End With
End If

End Sub