Discussion :

[dan-12]

Bonjour
J’ai utilisé le code ci dessous fait par ouskel’n’or pour supprimer des doublons.
Cela fonctionne très bien.
Je voudrais pouvoir supprimer des lignes en y mettant une autre condition, si je pars de ce tableau :

Pierre rouge
Pierre rouge
Pierre vert
Pierre vert
Michel rouge
Michel jaune
Michel jaune
Michel jaune

J’aimerai après traitement que toutes les lignes doubles sur les deux champs soient supprimées, ce qui donne comme résultat :

Pierre rouge
Pierre vert
Michel rouge
Michel jaune

Merci d’avance

Voici le code utilisé pour supprimer les doublons :

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
Private Sub CommandButton1_Click()
Dim FL1 As Worksheet
Dim Valeur As Variant, c As Range
Dim NoLigne As Long, DerLig As Long
    Set FL1 = Worksheets("annecy")
    NoLigne = 1
    Do
        If Not Cells(NoLigne, 1) = "" Then
            Valeur = Cells(NoLigne, 1)
            Do
                With FL1.Range("A" & NoLigne + 1, [A65536].End(xlUp))
                    DerLig = 0
                    Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not c Is Nothing Then
                        If c.Row > NoLigne Then
                            DerLig = c.Row
                            c.EntireRow.Delete
                        End If
                    End If
                    Set c = Nothing
                End With
            Loop While DerLig > NoLigne
       End If
        NoLigne = NoLigne + 1
    Loop While NoLigne < FL1.Range("A65536").End(xlUp).Row
End Sub

[ouskel'n'or]

Bonjour dan, bienvenue sur le forum.
Je ne sais pas où tu as pris ce code mais je pense qu'on peut faire bien mieux si tu peux trier tes données (par ordre alpha). Est-ce le cas ?
A+

[tomy7]

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
Sub TrouveDoublon()
    Dim Tableau() As TableauType
    Dim Cellule, Haut, Bas, Compteur, C2
    Colonne = 15
    Haut = Selection.End(xlUp).Row
    Bas = Selection.End(xlDown).Row
    ReDim Tableau(Bas)
    For Compteur = Haut To Bas
        Tableau(Compteur).Contenu = Cells(Compteur, Colonne)
        Tableau(Compteur).Coordonnee = Cells(Compteur, Colonne).Row
    Next
    For Compteur = Haut To Bas
        For C2 = (Compteur + 1) To Bas
            If Tableau(Compteur).Contenu = Tableau(C2).Contenu Then
                Cells(Tableau(C2).Coordonnee, Colonne + 1).Value = 1
                Cells(Tableau(C2).Coordonnee, Colonne - 13).Interior.ColorIndex = 6
                Cells(Tableau(C2).Coordonnee, Colonne - 12).Interior.ColorIndex = 6
                Cells(Tableau(C2).Coordonnee, Colonne - 11).Interior.ColorIndex = 6
                Cells(Tableau(C2).Coordonnee, Colonne - 10).Interior.ColorIndex = 6
                Cells(Tableau(C2).Coordonnee, Colonne - 9).Interior.ColorIndex = 6
            End If
        Next
    Next
End Sub

moi j avais utiliser ce code une fois mais on peut faire carrement mieu c est sur...

[Gorfael]

Salut à tous
une proposition

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
Sub test()
Dim Tab_Var() As String
Dim X As Long
Dim Y As Long
Dim Flg As Boolean
ReDim Tab_Var(0) 'initialisation du tableau variables
For X = UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    If Not (IsEmpty(Range("A" & X)) And IsEmpty(Cells(X, "B"))) Then
    'si A n'est pas vide, alors
        Flg = True
        'Balise à FAUX
        For Y = 0 To UBound(Tab_Var)
        'Pour Y=0 à limite index de Tab_Var
            If Cells(X, "A") & Cells(X, "B") = Tab_Var(Y) Then
            'si A & B ligne X = Tab_Var(Y)
                Flg = False
                'Balise à faux
                Cells(X, "D") = "X"     'XXXXXXXX
                'Marquer la cellule D (pour tester)
                'Rows(X).Delete         'XXXXXXXX
                'Supprimer la ligne
                Exit For
                'sortir de la boucle
            End If
        Next Y
        If Flg Then
        'si Balise = Vrai (pas trouver de doublon)
            ReDim Preserve Tab_Var(UBound(Tab_Var) + 1)
            'augmenter l'indice max de Tab_Var de 1
            'en conservant les valeurs
            Tab_Var(UBound(Tab_Var)) = Cells(X, "A") & Cells(X, "B")
            'Tab_Var(nouvel indice max) = A & B de ligne X
        End If
    End If
Next X
End Sub

Les lignes avec XXXXXX sont à supprimer/interchanger :
la première me sert à tester, quand c'est fini, je supprimes ou tranforme en commentaire
la seconde est à rendre active en supprimant l'apostrophe qui la passe en commentaire.

Comme on supprime des lignes, on travaille en remontant vers la ligne 1, pour éviter d'en oublier : si je supprime la ligne 10, la 11 devient 10 et n'est pas retestée, sauf usine à gaz

Comme je ne connais pas le problème, je parts de la dernière ligne de la plage de travail et supprime les lignes qui ont soit A soit B non vide et qui sont en doublons. ça ne répond pas exactement à la demande, mais la modif, si elle est nécessaire me semble facile.
A+

[dan-12]

J'ai trouvé ce code sur ce site, je trouve qu'il est tres pratique.

http://www.developpez.net/forums/sho....php?p=2452749

je peux trier les données mais cela n'est pas une obligation.
l'important est de supprimer les doublons en fonctions des conditions sur les deux champs.

[Gorfael]

Salut

je peux trier les données mais cela n'est pas une obligation.
l'important est de supprimer les doublons en fonctions des conditions sur les deux champs

Si tu tries les données, une simple boucle en remontant avec un test du genre : si A(n) = A(n-1) et B(n) = B(n-1) alors supprimer n suffit
A+

[dan-12]

Pour l’instant j’ai essayé le code de Gorfael et cela fonctionne très bien, merci.

J’aimerai aussi après traitement marquer chaque ligne ou il reste des doublons, par exemple le mot « oui » dans une cellule.

Ps : je suis nul en programmation, je ne fais que du copier coller

[ouskel'n'or]

Je suggère autre chose (!)
En passant par les collections :
On travaille sur la plage de données masquée.
Pour chaque ligne lue (dans les colonnes qui t'intéressent, ex : Colonne A -> Le nom, colonne B -> la couleur) on concatène les deux données qu'on ajoute à la collection, concaténées.
Si la donnée existe déjà dans la collection, ça provoque une erreur. Donc, si on a une erreur, on affiche la ligne.
La plage parcourue, et les doublons affichés, on supprime les lignes visibles.
Enfin on affiche les lignes encore masquées.

En prenant cette méthode :

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
Sub SupDoublonsSurDeuxColonnes()
Dim FL1 As Worksheet
Dim Collect As New Collection
Dim col As Range, plage As Range, Cell As Range
Dim NoLig As Long, DerCol As Integer
Dim derLig As Long, Donnee As String
    Set FL1 = Worksheets("feuil1")
    derLig = FL1.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    Set plage = FL1.Range("A1", "B" & derLig)
    plage.EntireRow.Hidden = True
    For NoLig = derLig To 1 Step -1
        Set Cell = FL1.Range("A" & NoLig)
        Donnee = FL1.Cells(Cell.Row, 1) & ";" & FL1.Cells(Cell.Row, 2) & ";"
        On Error Resume Next
            Collect.Add CStr(NoLig), Donnee
            If Err <> 0 Then
                FL1.Rows(Cell.Row).EntireRow.Hidden = False
            End If
            Donnee = ""
        Err.Clear
    Next
    FL1.Cells.SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    FL1.Cells.EntireRow.Hidden = False
End Sub

A+

[ouskel'n'or]

J’aimerai aussi après traitement marquer chaque ligne ou il reste des doublons,

De quels doublons parles-tu si on les a supprimés ?

[tomy7]

pour marquer les lignes:

tu fais :

Code :

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

1
2
3
4
5
Dim i as integer
for i = 1 to 100   'ici ta plage
if range("A" & i).value = "Pierre ou un autre comme tu veux" then  
range("A"& i).interior.colorindex = 3 ' change le nombre pour changer de couleur.
end if

3 <> rouge
5 <> bleu
10 <> vert

[dan-12]

merci mais ce code ne m'aide pas, j’ai des grands tableaux à traiter, plus de 8000 lignes, il faudrait pour que cela soit pratique, que je n’ai pas à entrer de valeur dans mon code, et que cela fonctionne en automatique comme la suppression des doublons.
Il est important que je puisse trier après le traitement d’où l’idée d’écrire « ou i » dans une colonne à chaque ligne dont la cellule comparée est en doublon.


si c'est plus simple on peut egalement apres le premier traitement supprimer toutes les lignes qui n'ont pas la cellule testé en doublon.
le resultat pour moi est le même.
si la valeur de la cellule testé est unique ,on supprime la ligne.
c'est compliqué!!

Désolé, je n’ai pas été très précis
J’aimerais marquer les lignes ou le premier champ est identique :
Exemple si le résultat après suppression des doublons est :

Pierre bleu
Pierre rouge
Jean vert
michel rouge

J’aimerais :

Pierre bleu oui
Pierre rouge oui
Jean vert
michel rouge

[ouskel'n'or]

Pour m'éviter de tout relire, je te repose la question : Peux-tu trier les données ?
A+

[dan-12]

oui pas de probleme

[ouskel'n'or]

Alors le code peut être beaucoup plus simple.
Tu tries les données, et ensuite tu pars de la dernière ligne vers la première

Code :

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

1
2
3
4
5
6
For NoLigne = DerLig to Premlig step -1'minimum N° 2
     If cells(NoLigne, 1) = Cells(NoLigne -1, 1) and cells(NoLigne, 2) = Cells(NoLigne -1, 2) Then
          Rows(NoLigne).entirerow.delete
          Cells(NoLigne-1, 3) = "oui"
     endif
Next

où la colonne 1 contient le nom, la 2 la couleur et la trois "oui". Tu adaptes.
Tu testes ?
A+

[dan-12]

merci à tous
c'est tellement simple
je peux trier mes données selon mes besoins