Suppression de doublons

**ANTMA** · 15/12/2007, 18h23

Bonjour,

je sais je commence à inonder votre forum mais je dois finirsa ce weekend, j'ai besoin de suprimmer les lignes ou il y a des doublons dans une colonne la numéro 5 .

J'ai besoin de supprimer la ligne ou il ya un doublons dans cette colonne

Ex

24112004 XF009 J 345
24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XF009 Y 5
24112004 XT009 J 35
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 P 45
24112004 XZ009 Y 34

**ouskel'n'or** · 15/12/2007, 19h42

Bonsoir ANTMA,
Tu as le code dans la FAQ http://excel.developpez.com/faq/inde...eDoublonsPlage à l'article Comment supprimer les doublons contenus dans une plage de cellules ?
Bonne soirée

**ANTMA** · 16/12/2007, 19h03

Bonjour,

effectivement ce code marche tres bien mais le problème est que j'ai une série de donné qui se présente comme ceci :

24/11/2007 RF0006 J 90
24/11/2007 RF0006 J 90
24/11/2007 RF0006 P 8
24/11/2007 RF0006 P 8

etc et sa change à chaque fois les dates , les ref et les classes je veux juste conserver une classe et une date et une ref par exemple ici je veux

24/11/2007 RF0006 J 90
24/11/2007 RF0006 P 8

**ANTMA** · 16/12/2007, 19h05

24112004 XF009 J 345
24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XF009 Y 5
24112004 XT009 J 35
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 P 45
24112004 XZ009 Y 34

Avec cet exemple je veux juste conserver

24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 Y 34

**fred65200** · 16/12/2007, 20h38

bonsoir,

je ne comprends pas bien ton problème, Ouskel'n'or t'a placé un lien.
Il faut un peu adapter le code à ton cas

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
42
43
44
45
46
 
Option Explicit
Option Base 1
 
 
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim derLi As Long
    derLi = Columns(5).Find("*", , , , , xlPrevious).Row
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = Worksheets("Feuil1").Range("E1:E" & derLi)
 
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        On Error Resume Next
        '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
        End If
 
        On Error GoTo 0
    Next Cell
 
    '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
        Worksheets("Feuil1").Rows(Tableau(x)).EntireRow.Delete
    Next x
 
    Application.ScreenUpdating = True
End Sub

Avec ce code, tu n'auras effectivement pas le résultat que tu donnes dans ton précédent post.

Avec ces données

24112004 XF009 J 345
24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XF009 Y 5
24112004 XT009 J 35
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 P 45
24112004 XZ009 Y 34

la liste des occurrences uniques est

24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XT009 J 35
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 P 45
24112004 XZ009 Y 34

et non

24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 Y 34

cordialement

**ouskel'n'or** · 17/12/2007, 00h49

Une autre adresse http://www.developpez.net/forums/sho...d.php?t=192445
Il y a de nombreux exemples sur le forum mais aucun ne correspondra strictement à ton fichier... faut adapter et donc essayer de comprendre le code.
Bonne soirée et bon courage.
(Bonsoir Fred)

**ANTMA** · 17/12/2007, 12h02

Bonjour,

j'ai adpaté le code suivant à mon cas en remplacant "Feuil1" par mon nom de feuil etc mais je ne comprends pas ce qui faut mettre à cette ligne

Code :

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

 derLi = Columns(5).Find("*", , , , , , xlPrevious).Row

Merci du coup de main désolé je suis débutant

**fred65200** · 17/12/2007, 12h05

bonjour

Code :

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

   derLi = Sheets("Feuil1").Columns(5).Find("*", , , , , xlPrevious).Row

Cette ligne de code te permet de trouver la dernière ligne renseignée de la colonne 5 de la feuille Feuil1.

OK?

**ANTMA** · 17/12/2007, 12h35

doànc je change rien je la laisse comme ça ?

**fred65200** · 17/12/2007, 12h38

re

Code :

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

   derLi = Sheets("Feuil1").Columns(5).Find("*", , , , , xlPrevious).Row

Tu changes le nom de l'onglet et le numéro de colonne suivant tes besoins.

Ici, je répète, on cherche la dernière ligne de la colonne E de l'onglet Feuil1.

EDIT pour "simplifier"

Code :

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

1
2
3
4
5
6
7
   Dim F1 As Worksheet
Dim derLi As Long
 Set F1 = Sheets("Feuil1")
  derLi = F1.Columns(5).Find("*", , , , , xlPrevious).Row
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = F1.Range("E1:E" & derLi)

@+

**ANTMA** · 17/12/2007, 13h09

Ce ne marche pas il me met un débogage sur cette ligne

Code :

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

derLi = Sheets("prestation").Columns(5).Find("*", , , , , xlPrevious).Row

Voici mon code

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
42
43
44
45
46
Option Explicit
Option Base 1
 
 
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim derLi As Long
    derLi = Sheets("prestation").Columns(5).Find("*", , , , , xlPrevious).Row
    'derLi = Columns(5).Find("J", "P", "Y", "S", "C", "M", xlPrevious).Row
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = Worksheets("prestation").Range("E1:E19043" & derLi)
 
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        On Error Resume Next
        '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
        End If
 
        On Error GoTo 0
    Next Cell
 
    '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
        Worksheets("prestation").Rows(Tableau(x)).EntireRow.Delete
    Next x
 
    Application.ScreenUpdating = True
End Sub

**fred65200** · 17/12/2007, 13h15

re

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
42
43
44
45
46
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim derLi As Long
     dim F1 as worksheet


Set F1 = sheets("prestation")
derLi = F1.Columns(5).Find("*", , , , , xlPrevious).Row
  
    
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = F1.Range("E1:E" & derLi)
    
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        On Error Resume Next
        '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
        End If
        
        On Error GoTo 0
    Next Cell
    
    '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
        F1.Rows(Tableau(x)).EntireRow.Delete
    Next x
    
    Application.ScreenUpdating = True
End Sub

en modifiant ce qui est en gras bleu est ce que ça fonctionne

Sinon quel type d'erreur?

@+

**ANTMA** · 17/12/2007, 13h44

Bonjour,

Avec ce code cela marche mais ça ne correspond à ce que je cherche à faire

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
42
43
44
45
46
Option Explicit
Option Base 1
 
 
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim derLi As Long
    derLi = Sheets("prestation").Columns(5).Find("*", , , , , xlPrevious).Row
 
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = Worksheets("prestation").Range("E1:E" & derLi)
 
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        On Error Resume Next
        '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
        End If
 
        On Error GoTo 0
    Next Cell
 
    '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
        Worksheets("prestation").Rows(Tableau(x)).EntireRow.Delete
    Next x
 
    Application.ScreenUpdating = True
End Sub

Il me supprime quasiment tout alors qu'il faudrait qu'il me supprime les lignes des classes qui sont en double mais en fonction des dates et des ref

Si la classes est la même que ceux de la ligne du dessous il faut vérifier que les dates et les ref sont les mêmes sinon il ne faut pas supprimer la ligne.

**fred65200** · 17/12/2007, 13h49

Re

On peut dire que tu n'es pas très explicite.
Dans ton premier post, tu laisses entendre que la colonne 5 contient des données de type 24112004 XF009 J 345, tu ne dis pas que ces données sont sur plusieurs colonnes

Envoyé par ANTMA

Bonjour,

je sais je commence à inonder votre forum mais je dois finir ce weekend, j'ai besoin de suprimer les lignes ou il y a des doublons dans une colonne la numéro 5 .

J'ai besoin de supprimer la ligne ou il y a un doublons dans cette colonne

Ex

24112004 XF009 J 345
24112004 XF009 J 345
24112004 XF009 P 45
24112004 XF009 P 45
24112004 XF009 Y 5
24112004 XF009 Y 5
24112004 XT009 J 35
24112004 XT009 J 34
24112004 XT009 P 45
24112004 XZ009 P 45
24112004 XZ009 Y 34

Pourquoi n'utilises tu pas le filtre élaboré (ou avancé je ne sais plus) avec Extraction sans doublon?

sinon envoie ton classeur sans donnée personnelle au format ZIP

@+

**ANTMA** · 17/12/2007, 14h16

je sais désolé je me suis mal exprimé.
En effet je peux faire l'extraction sans doublon avec le filtre élaboré mais j'ai des données sur plus d'un mois et sa fait beaucoup.

voici un exemple date donné mais j'quasiment un mois de donnée

Date Ref Classe Valeur
24/11/07 XS0006 P 4
24/11/07 XS0006 P 4
24/11/07 XS0006 J 66
24/11/07 XS0006 J 66
24/11/07 XS0006 Y 235
24/11/07 XS0006 Y 235
24/11/07 XS1114 C 19
24/11/07 XS1114 S 7
24/11/07 XS1114 C 3
24/11/07 XS1114 S 8
24/11/07 XS1114 M 39
24/11/07 XS7712 Y 150
24/11/07 XS7714 Y 158
24/11/07 XS7720 Y 139
24/11/07 XS7724 Y 140
24/11/07 XS7780 Y 141
24/11/07 XS7794 Y 164

**fred65200** · 17/12/2007, 14h41

re

S'il te plaît, ne modifies rien au code si tu ne le comprends pas.
en supposant que les valeurs que tu as données sont placées en B1:E18
et que tu veux supprimer les doublons Date Ref Classe sans te préoccuper des Valeurs.

Tu nous tiens au courant.

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
42
43
44
45
46
47
48
49
 
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim derLi As Long
     Dim F1 As Worksheet
 
 
Set F1 = Sheets("prestation")
derLi = F1.Columns(5).Find("*", , , , , xlPrevious).Row
    F1.Columns("F:F").Insert Shift:=xlToRight
    F1.Range("F2:F" & derLi).FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-2]"
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = F1.Range("F1:F" & derLi)
 
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        On Error Resume Next
        '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
        End If
 
        On Error GoTo 0
    Next Cell
 
    '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
        F1.Rows(Tableau(x)).EntireRow.Delete
    Next x
        F1.Columns("F:F").Delete Shift:=xlToLeft
 
    Application.ScreenUpdating = True
End Sub

@+

**ANTMA** · 17/12/2007, 15h01

En fait c'est presque çà mais mes valeurs sont situé entre les colonnes

A et F et finisse ligne 19043

et dans mon exemple :

24/11/07 XS0006 P 4
24/11/07 XS0006 P 4
24/11/07 XS0006 J 66
24/11/07 XS0006 J 66
24/11/07 XS0006 Y 235
24/11/07 XS0006 Y 235
24/11/07 XS1114 C 19
24/11/07 XS1114 S 7
24/11/07 XS1114 C 3
24/11/07 XS1114 S 8
24/11/07 XS1114 M 39
24/11/07 XS7712 Y 150
24/11/07 XS7714 Y 158
24/11/07 XS7720 Y 139

je ne veux garder que ces lignes là (supprimer les lignes en double qui ont la même valeur)
24/11/07 XS0006 P 4
24/11/07 XS0006 J 66
24/11/07 XS0006 Y 235
24/11/07 XS1114 C 19
24/11/07 XS1114 S 7
24/11/07 XS1114 C 3
24/11/07 XS1114 S 8
24/11/07 XS1114 M 39
24/11/07 XS7712 Y 150
24/11/07 XS7714 Y 158
24/11/07 XS7720 Y 139

Merci vraiment bocoup vous me sortez vraiment de la mouise

**fred65200** · 17/12/2007, 15h03

il serait vraiment plus simple que tu "upload" un fichier sans donnée personnelle au format Zip

Tu me présentes 4 colonnes et tu m'écris qu'elles sont en A et F ??

@+

**fred65200** · 18/12/2007, 00h18

bonsoir,

je te laisse adapter

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
42
43
44
45
46
47
48
49
50
51
52
53
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim derLi As Long
     Dim F1 As Worksheet

    'Fige l'écran pendant la suppression des lignes
    Application.ScreenUpdating = False

   Set F1 = Sheets("prestation")
   derLi = F1.Columns(5).Find("*", , , , , xlPrevious).Row
    'insertion d'une colonne pour concatenation des données
   F1.Columns("G:G").Insert Shift:=xlToRight
   ' concaténation
   ' ici je t'ai mis les cellules C & D & E & F, ajuste à ton cas car je n'ai toujours pas compris
   ' -1 --> F, -2 --> E, -3 --> D, etc.
   F1.Range("G2:G" & derLi).FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-2]&RC[-1]"
    
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = F1.Range("G1:G" & derLi)
    
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        On Error Resume Next
        '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
        End If
        
        On Error GoTo 0
    Next Cell
    
    'On sort si aucun doublon n'a été trouvé.
    If x = 0 Then GoTo Fin 'Exit Sub
    
    'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
    For x = UBound(Tableau) To LBound(Tableau) Step -1
        F1.Rows(Tableau(x)).EntireRow.Delete
    Next x
Fin:
     'suppression de la colonne G
     F1.Columns("G:G").Delete Shift:=xlToLeft

    Application.ScreenUpdating = True
End Sub

cordialement

**ANTMA** · 18/12/2007, 14h28

Bonjour,
cela marche niquel chrome merci beaucoup sauf que j'ai juste un dernier petit problème qui concerne certaines qui sont en doublons de classe mais pas de valeur.

Le code que j'utilise fonctionne nickel pour les données en double de ce type :

24/11/2007 XF0006 P 45
24/11/2007 XF0006 P 45

Mais j'ai aussi des données en double de cetype (doublons de classe mais pas de valeur)

24/11/2007 XF008 Y 54
24/11/2007 XF008 Y 13

Dans ce cas là il faudrait que la ligne supprimer soit celle de la valeur la plus faible

par avnce merci de votre aide précieuse

Suppression de doublons

Macros et VBA Excel

Discussions similaires

Partager

Partager