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)

**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 ??

@+

**ouskel'n'or** · 19/12/2007, 14h24

Ok, j'ai vu.
Donc,

Envoyé par ce que tu as mis

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

C'est pas ça ! Faudrait savoir

Alors il va falloir bricoler tout ça pour que ça fonctionne.
Dans le code de Fred, il crée une collection avec une clé mais n'utilise pas l'item. Tu vas devoir utiliser les deux.
Pour ça, l'item sera sous forme de variable que tu pourras utiliser pour stocker la valeur de la classe et aditionner la nouvelle à l'ancienne en cas de doublon.
Je regarde ce qu'on peut faire. Ce n'est peut-être pas très compliqué.
A+

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

Merci beaucoup

**ouskel'n'or** · 19/12/2007, 16h45

Voilà. J'ai ré-écrit car je n'aime pas partir d'un code tout fait (désolé, Fred)

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
Option Explicit
Sub SupKilDelPlus()
Dim Derlig As Long, Donnee As String
Dim NoCol As Integer, NoLig As Integer
Dim Collect As New Collection, NewVal As Integer
Dim oldLig, Cell As Range, OldVal As Integer
    Derlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
    For NoLig = Derlig To 1 Step -1
        Set Cell = Range("A" & NoLig)
        On Error Resume Next
        Donnee = Cell & Cell.Offset(0, 1) & Cell.Offset(0, 2)
        Collect.Add NoLig & ";" & Cell.Offset(0, 3), Donnee
        If Err <> 0 Then
            oldLig = Val(Split(Collect(Donnee), ";")(0))
            OldVal = Val(Split(Collect(Donnee), ";")(1))
            NewVal = CStr(OldVal + Cell.Offset(0, 3))
            Cell.Offset(0, 3) = NewVal
            Rows(oldLig).EntireRow.Delete
            Collect.Remove Donnee
            Collect.Add NoLig & ";" & NewVal, Cell.Row
        End If
        Err.Clear
    Next
End Sub

Si tu veux des explications, va falloir qu'on passe par skype par que sinon, on y passera la nuit.
A+

NB - J'ai supposé tes données placées de A1 à A & Dernière Ligne dans les colonnes A,B,C et D

**ANTMA** · 19/12/2007, 17h21

Questions :

je dois mettre ce code à la suite de l'autre ???

**ZeitnotZatopek** · 27/12/2007, 13h48

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
' En fonction de la colonne choisie, ici j'ai mis les 3
 
Sub Doublons()
 
Dim Lig
 
Lig = 2
 
Cells(1, 1).Select
 
Do While Cells(Lig, 1) <> ""
 
    If Cells(Lig, 1).Value = Cells(Lig - 1, 1).Value _
       and Cells(Lig, 2).Value = Cells(Lig - 1, 2).Value _ 
       and Cells(Lig, 3).Value = Cells(Lig - 1, 3).Value _
Then
 
        Rows(Lig).Delete
        Lig = Lig - 1
 
    End If
 
    Lig = Lig + 1
 
Loop
 
Cells(1, 1).Select
 
End Sub

Suppression de doublons

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager