Discussion :

[vincent12345]

Bonjour à tous,
Je cherche à créer une macro qui me permettrait d'identifier les doublons sur l'identifiant (colonne A) et si doublon il y a de supprimer:
- la ligne qui a la note la plus basse (colonne B),
si les deux lignes ont la même note de supprimer une des deux lignes.
Merci pour votre aide.
En pj un extract du fichier!

[MlNOU]

Bonjour,

Ce genre de question a deja été posé à de nombreuses reprises, je pense qu'une petite recherche s'impose et si tu as toujours besoin d'aide les autres membres et moi même nous ferons un plaisir de t'aider.


Cordialement MlNOU.

[Invité]

http://www.developpez.net/forums/d13...n/#post7154257

[Marc-L]

Bonjour,

toutefois, il serait bien de connaître la version d'Excel et de savoir
si l'ordre des données peut être modifiée ou s'il doit rester tel quel ?

[vincent12345]

j'ai déjà chercher...mais pas trouver dans le forum..je vais reregarder.
Oui effectivement on peut trier les données (j'avais essayer de trier sur l'identifiant pour repérer les doublons entre i et i-1) mais ma macro n'avait pas marché
merci pour votre aide

[EngueEngue]

Après avoir trié ton classeur par identifiant et en supposant que ce soit sur la feuille 1 et que la première ligne soient des entêtes et tes données ne soient pas espacées...

Code malpropre mais qui marche:

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
Sub toto()
Dim i As Long
With Feuil1
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        If .Cells(i, 1) = .Cells(i + 1, 1) And .Cells(i, 1) <> "" Then
            If .Cells(i, 2) > .Cells(i + 1, 2) Then
                .Cells(i + 1, 1).EntireRow.Delete
                i = i - 1
            Else
                .Cells(i, 1).EntireRow.Delete
                i = i - 1
            End If
        End If
    Next i
End With
End Sub

[Marc-L]

Vincent, voici mon code qui trie puis ne conserve que la meilleure note :

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
Sub GardeMeilleureNote()
    If Application.CountA(Columns(2)) > 1 Then
        Application.ScreenUpdating = False
        N& = [B1].End(xlDown).Row
 
        Range("A1:B" & N).Sort [A1], xlAscending, [B1], Order2:=xlDescending, _
                               Header:=xlYes, DataOption1:=xlSortTextAsNumbers
 
        For R = N To 3 Step -1
            If Cells(R, 1) = Cells(R - 1, 1) Then Rows(R).Delete
        Next
 
        Application.ScreenUpdating = True
    End If
End Sub

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …


__________________________________________________________________________________________
Un scientifique lira des centaines de livres au cours de sa vie, mais sera toujours persuadé qu'il lui reste beaucoup à apprendre.
Un religieux n'en lira qu'un et sera persuadé d'avoir tout compris …