Discussion :

[Neptune64]

Bonjour,

Cette macro me permet de supprimer les doublons selon une sélection. Comme je supprime la ligne, elle se décale et j'ai à chaque fois une ou plusieurs lignes qui ne sont pas sélectionnées, donc pas supprimées. Je n'arrive pas à continuer la boucle jusqu'à qu'il n'y a plus de doublons elle s'arrête à la fin du 1er passage !!

Merci de votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub supprime_doublon()
'Repère les doublons 
Dim Collec As New Collection, Cell As Range, Plage As Range
 
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub
 
For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.EntireRow.Delete
 
Else
Cell.Interior.ColorIndex = 6
End If
End If
 
Next Cell
 
End Sub

[Gorfael]

Salut Neptune64 et le forum
Sujet mainte fois traité

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub supprime_doublon()
'Repère les doublons
Dim Collec As New Collection, Plage As Range
Dim X As Long
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub
For X = Plage.Count To 1 Step -1
    If Plage.Cells(X) <> "" Then
        Collec.Add Plage.Cells(X), CStr(Plage.Cells(X))
        If Err <> 0 Then
            Err.Clear
            Plage.Cells(X).EntireRow.Delete
        Else
            Plage.Cells(X).Interior.ColorIndex = 6
        End If
    End If
Next X
End Sub

J'ai pas testé (la flemme), mais comme c'est un fonctionnement connu...
Un code indenté est plus lisible
A+

[Neptune64]

Salut Gorfael et merci
C'est juste que ce sujet à mainte fois été traité mais je n'arrivais pas à la mettre dans le bons sens !! Ta macro fonctionne très bien mais j'avais besoin que les lignes soient traitées de haut en bas. Dans ta macro ça me garde la dernière et ensuite me supprime les doublons contre le haut.
Mais avec le macro qui suivante ça fonctionne comme je le désire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub supprime_doublon()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
 
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub
 
    On Error Resume Next
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        'Création d'une collection de données uniques (sans doublons)
        Un.Add Cell, CStr(Cell)
 
        'Une erreur survient si l'élément existe dans la collection.
        'La procédure enregistre le numéro de ligne correspondant dans un tableau.
        If Err.Number <> 0 Then
            x = x + 1
            ReDim Preserve Tableau(1 To x)
            Tableau(x) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0
 
    'On sort si aucun doublon n'a été trouvé.
    If x = 0 Then Exit Sub
 
    'Fige l'écran pendant la suppression des lignes
    Application.ScreenUpdating = False
 
    'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
    For x = UBound(Tableau) To LBound(Tableau) Step -1
    ActiveSheet.Rows(Tableau(x)).EntireRow.Delete
 
    Next x
 
    Application.ScreenUpdating = True
End Sub

[Gorfael]

Salut Neptune64 et le forum
Plus tu es précis dans les infos que tu nous donnes, plus on est à même de t'aider.
Tu peux utiliser Plage.cells(x) en augmentant. Il suffit, à chaque suppression de ligne de décrémenter ne même temps X. Mais ça suppose que plage n'ai qu'une seule colonne, ce qui n'est pas précisé.
De même, ne connaissant pas la longueur de plage, te proposer une méthode passant par les filtres élaborés ne sera sans doute pas plus rapide.
A+