Suppression des doublons

Bonjour à tous !

Je suis face à une nouvelle problématique : je dois "nettoyer" une colonne de ses doublons, des valeurs comprises entre -19,000 et 35,000. Voyez par vous même avec la capture ci-dessous.

L'idée est de supprimer une des deux valeurs sélectionnée, avec les deux autres cases qui l'entoure, en décalant les cellules dessous vers le haut.

Voici mon code, qui ne marche uniquement pour les 500/1000 premières valeurs (et je ne comprend pas pourquoi). Pour info, j'ai environ 60000 lignes à traiter.

Private Sub Suppression_des_doublons()

Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim dl, k As Long, x, x1 As Single

Set ws1 = Sheets("Extrapolation")
dl = ws1.Range("E6").End(xlDown).Row
k = 5

For i = 6 To dl

    If Range("E" & i) = Range("E" & i + 1) Then

        Range("D" & i).Delete
        Range("E" & i).Delete
        Range("F" & i).Delete

    End If
Next

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Merci d'avance pour tout les retours !

J'ai continuer à travailler dessus, et ça marche mieux mais je n'arrive pas a traiter toutes les lignes. Les 3000 dernières lignes résistent encore et toujours à l'envahisseur Romain... Des idées ?

(J'ai changé l'ordre des colonnes à traiter, c'est mieux)

For i = 6 To dl
    If Range("E" & i) = Range("E" & i + 1) Then

        Range("F" & i).Delete
        Range("E" & i).Delete
        Range("D" & i).Delete

    End If
Next

Bonjour,

Pour trouver la dernière ligne, on pratique rarement comme vous le faites sauf si l'organisation des données l'impose.

Il faut toujours remonter à partir de la dernière ligne Excel pour éviter les "trous dans la raquette"...

Faites plutôt :

With  ws1
    dl =.Cells(.Rows.count,"E").End(xlUp).Row
End with

En ce qui concerne la suppression, on part toujours de la fin pour éviter la désindexation. Nb : Je n'ai pas testé le code ci-dessous.

For i = dl To 7 Step -1
    If Range("E" & i) = Range("E" & i - 1) Then

        Range("F" & i - 1).Delete
        Range("E" & i - 1).Delete
        Range("D" & i - 1).Delete

    End If
Next

Merci beaucoup du retour ! J'essaye et je vous tiens au courant.

C'est vrai que j'oublie tout le temps de partir de la fin...

Edit : Le comptage fonctionne, cependant, la suppression des doublons toujours pas. Je vous mets mon fichier en PJ si ça vous intéresse. Il faut juste changer le nom de la ws1 en "Feuil1" .

Bonjour, aucunes idées parmis vous ?

Option Explicit

Sub Suppression_des_doublons()

Dim Ws1 As Worksheet
Dim I As Integer, dl As Integer

    With Application
         .Calculation = xlManual
         .ScreenUpdating = False
    End With

    Set Ws1 = Sheets("Feuil1 (2)")
    With Ws1
         dl = .Cells(.Rows.Count, "E").End(xlUp).Row
         For I = dl To 6 Step -1
             If "'" & .Cells(I, "E") = "'" & .Cells(I - 1, "E") Then
                .Cells(I - 1, "E").EntireRow.Delete
                'Debug.Print I & " : " & Range("E" & I)
                '.Cells(I, "E").Interior.Color = RGB(255, 255, 0)
              End If
        Next I
    End With
    Set Ws1 = Nothing

    With Application
         .Calculation = xlAutomatic
         .ScreenUpdating = True
    End With

End Sub

Merci ! J'essaye et vous tiens au courant.

Edit : Tout fonctionne parfaitement, merci beaucoup. J'ai du définir les variables i et dl en tant que Long car j'avais un dépassement de capacité. En revanche, est-ce possible de supprimer uniquement les 3 cellules concernées ? Car je ne veux pas supprimer les valeurs enregistrées dans les colonnes A, B et C.

Re-

J'ai résolu tout mes soucis grâce à tes conseils. Encore merci pour ton temps Eric.

Voici le code final si il y as des intéressé.

Private Sub Suppression_des_doublons2()

Dim Ws1 As Worksheet
Dim I, J, dl, dl2 As Long

    With Application
         .Calculation = xlManual
         .ScreenUpdating = False
    End With

    Set Ws1 = Sheets("Extrapolation")
    With Ws1

         dl = .Cells(.Rows.Count, "E").End(xlUp).Row
         For I = dl To 6 Step -1
             If "'" & .Cells(I, "E") = "'" & .Cells(I - 1, "E") Then
                .Cells(I - 1, "F").Delete
                .Cells(I - 1, "E").Delete
                .Cells(I - 1, "D").Delete
                'Debug.Print I & " : " & Range("E" & I)
                '.Cells(I, "E").Interior.Color = RGB(255, 255, 0)
              End If
        Next I

        dl2 = .Cells(.Rows.Count, "B").End(xlUp).Row
         For J = dl2 To 6 Step -1
             If "'" & .Cells(J, "B") = "'" & .Cells(J - 1, "B") Then
                .Cells(J - 1, "C").Delete
                .Cells(J - 1, "B").Delete
                .Cells(J - 1, "A").Delete
                'Debug.Print I & " : " & Range("E" & I)
                '.Cells(I, "E").Interior.Color = RGB(255, 255, 0)
              End If
        Next J

    End With
    Set Ws1 = Nothing

    With Application
         .Calculation = xlAutomatic
         .ScreenUpdating = True
    End With

End Sub

Re-, finalement, ce code ne me convient pas, il prend 5min minimum à se réaliser (100000+ mesures à traiter aussi...), j'ai donc décider de changer d'approche.

Plutôt que de passer via une comparaison cellule par cellule, je vais tout mettre dans un objet tableau, le traiter, puis le réinsérer sur Excel (si j'y arrive bien sur).

Je vais tenir cet onglet actif au fur et a mesure de mes avancées, mais si vous avez une idée qui vous passe par la tête, n'hésitez pas à me la partager ;)

Au lieu d'utiliser un Delete, effacez seulement la ligne et faites un tri à la fin.

une function d'excel elle-même, remove duplicates,

Ou bien on regarde vers les 3 colonnes E, F & G ou bien une colonne, faitez le choix !

Sub Doublons()
     With ws1
          dl = .Cells(.Rows.Count, "E").End(xlUp).Row
          .Range("E1:G" & dl).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes '3 colonnes !!!!
          .Range("E1:G$" & dl).RemoveDuplicates Columns:=1, Header:=xlyes'1 colonne !!!
     End With
End Sub

Eric, je ne peux pas me permettre de supprimer une ligne entiere, car les valeurs des colonnes A, B et C sont indépendantes de celles présentes en D, E et F.

BsAlv, je vais regarder, merci du retour ! Cependant, cette fonction analyse et traite des cellules non ? Sur 100000+ cellules a analyser, cela va prendre du temps je pense. Dans tout les cas, je vais tester et si c'est efficace, je le garderais.

Merci à tout les deux pour vos retours

Alors pourquoi les laisser dans le même onglet ?

removeduplicates est une function propre d'excel donc vite !

Dans mon exemple avec 100k lignes = 0.6 sec !!!

Re- tout le monde.

Pour clôturer ce sujet, je viens vous mettre mon code final, au cas où il y aurait des curieux.

Finalement, j'ai utilisé la méthode de BsAlv, qui est effectivement très efficace :)

Merci encore pour votre aide à tout les deux !

Private Sub Inter_Suppression_des_doublons_2_0()

Set ws1 = Sheets("Traitement")
Set ws2 = Sheets("Inter1")
Set ws3 = Sheets("Inter2")

Dim dl As Long

With ws2

dl = .Cells(.Rows.Count, "B").End(xlUp).Row

    For i = 6 To dl
        If .Cells(i, 1) = "" Then
        .Cells(i, 1) = "."
        End If
    Next

    .Range("A6:C" & dl).RemoveDuplicates Columns:=2, Header:=xlNo

End With

With ws3

    dl = .Cells(.Rows.Count, "B").End(xlUp).Row

    For i = 6 To dl
        If .Cells(i, 1) = "" Then
        .Cells(i, 1) = "."
        End If
    Next

    .Range("A6:C" & dl).RemoveDuplicates Columns:=2, Header:=xlNo

End With

End Sub