Suppression des doublons

Bonjour le forum

Sur le fichier jont, je souhaiterai supprimer tous les doublons. Avez vous une solution ?

Merci de vos commentaires avisés

Bonjour,

Sub Doublons()
Dim Unique As Object, Cel As Range
Set Unique = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("a2:a" & [a65000].End(xlUp).Row)
        If Not Unique.Exists(Cel.Value) Then Unique.Add Cel.Value, Cel.Value
    Next Cel
    Range("a2:a" & [a65000].End(xlUp).Row).Delete Shift:=xlUp
    Range("a2:a" & Unique.Count + 1) = Application.Transpose(Unique.items)
End Sub

Amicalement

Claude

un grand merci ! Cela fonctionne

re,

Tu peux aussi supprimer la ligne entière en remplaçant cette ligne

Sub Doublons()
Dim Unique As Object, Cel As Range
Set Unique = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("a2:a" & [a65000].End(xlUp).Row)
        If Not Unique.Exists(Cel.Value) Then Unique.Add Cel.Value, Cel.Value
    Next Cel
[barrer]'Range("a2:a" & [a65000].End(xlUp).Row).Delete Shift:=xlUp[/barrer]
Range("a2:a" & [a65000].End(xlUp).Row).EntireRow.Delete
    Range("a2:a" & Unique.Count + 1) = Application.Transpose(Unique.items)
End Sub

N'oublie pas la petite formalité

Bonsoir,

Sub SupDoublonsColonne()
  Set d = CreateObject("Scripting.Dictionary")
  Set début = Cells(2, 1)
  a = Range(début, début.End(xlDown))
  For Each c In a
    d(c) = ""
  Next c
  Range(début, début.End(xlDown)).ClearContents
  début.Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub

Ceuzin

Bonjour,

je me permets de relancer la discussion.

Comment supprimer les doublons en prenant plusieurs colonnes en considération voir toute la feuille(histoire de m'éviter de spécifier les colonnes?

Up! Ce sujet m'intéresse et en particulier la dernière question.

J'ai une liste de 4200 lignes sur 4 colonnes et j'ai besoin de supprimer tous les doublons ligne à ligne.

C'est à dire que si chaque cellule (4 cellules car 4 colonnes) de la ligne inférieure est identique à chaque cellule de la ligne supérieure, alors on supprime la ligne inférieure.

Voilà le code que j'ai mis en place, il marche pendant un certain temps mais fini toujours par se bloquer environ à mi-chemin en indiquant "erreur 1004, erreur définie par l'application ou par l'objet".

Sub vehicle_comparison()

Dim i As Long
Dim j As Long
Dim lignfin As Long
Dim k As Integer

'Récupération de la liste des véhicules
Sheets.Add After:=Sheets("Analyse")
ActiveSheet.name = "..."

Application.ScreenUpdating = False

Workbooks("DATA Hybrides JATO").Sheets("...").Columns("A:B").Value = Workbooks("DATA Hybrides JATO").Sheets("Classeur JATO - Feuille 1").Columns("H:I").EntireColumn.Value
Workbooks("DATA Hybrides JATO").Sheets("...").Columns("C:C").Value = Workbooks("DATA Hybrides JATO").Sheets("Classeur JATO - Feuille 1").Columns("K:K").EntireColumn.Value
Workbooks("DATA Hybrides JATO").Sheets("...").Columns("D:D").Value = Workbooks("DATA Hybrides JATO").Sheets("Classeur JATO - Feuille 1").Columns("M:M").EntireColumn.Value

'Suppression des doublons

Cells(1, 1).End(xlDown).Select
lignfin = ActiveCell.Row

For i = lignfin To 1 Step -1
    k = 0
    For j = 1 To 4
        If Cells(i, j).Value = Cells(i - 1, j).Value Then
            k = k + 1
        End If
    Next
    If k = 4 Then
        Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

'Workbooks("DATA Hybrides JATO").Sheets("Analyse").Activate

End Sub

Désolé, je me rends compte que j'ai oublié de vous dire bonjour

Bonjour,

C'est normal : Il n'existe pas de ligne 0 ("zéro") !

remplacer :

For i = lignfin To 1 Step -1 'par :
For i = lignfin To 2 Step -1

A+

Merci galopin! Une fois de plus tu me sauves, et pour une erreur vraiment bête cette fois là... j'avais pensé à tout sauf à ça

Ca a marché parfaitement en tout cas, merci beaucoup