Suppression de Doublons avancée Résolu/Fermé

Question

Bonjour, 

J'ai une liste assez grande comportant des données de la colonne C à AV. A coté de ces colonnes, il y a des formules de concaténation pour différents calculs, il ne faut donc pas toucher à ces colonnes.

Il est possible qu'en colonne AV, il y ait deux fois le meme nom  ex: M000001-A2_8 et c'est sur cette colonne que j'aimerais regarder s'il existe des doublons du nom. Car en colonne I, le nombre de pièces peut varier pour le doublon des noms... 
Cela vient du temps de la prise des données sur les machines. Les fichiers de données ne sont certaines fois pas encore remplis lorsque la macro vient les chercher. Il existe donc par exemple la ligne de donnée :
C: 123 pièces  AV:M000001_A2-8
C: 150 pièces  AV:M000001_A2-8

Il faudrait donc faire un test pour supprimer la ligne doublon du nom ayant le PLUS PETIT NOMBRE DE PIECES en colonne C.

J'ai déja réussi a trouver le doublons à l'aide de la macro :

sub doublons()
doublon = Range("AV65000").end(xlUp).value
if application.countIf(Range("AV2:AV" & Range("AV65000").end(xlUP).row),Doublon) > 1 Then
*ici je ne sais pas comment faire*
end if 
end sub

J'espère avoir été clair. Et je sais que cette macro va surement être un léger challenge a relever pour vous ;-)
Je vous en remercie déjà !

Bonne journée

rEVOLV3r
Configuration: Windows 7 / Internet Explorer 9.0

Le Pingou · Answer

Bonjour,
Question, si plus de 2 valeurs identique en [AV] qu'elle valeur prendre pour [C] ... ?

Le Pingou · Answer

Bonjour,
Merci pour l'information, ma proposition dans la journée.

Le Pingou · Answer

Bonjour,
Petite question, est-ce que l'on peut  supprimer le doublon et on prend la valeur maximum de [C] pour la ligne unique  ... ?
Ou supprimer uniquement la ligne qui à la valeur minimum.... ?

Le Pingou · Answer

Bonjour,
Note je n'ai pas pris en compte votre dernier message.
Essayer cette procédure :
Sub supprDoublonsColAV()
Dim sh As Object, mondico As Object
Dim a As Variant, i As Integer
Application.ScreenUpdating = False
Set sh = ActiveSheet
i = 1
Set mondico = CreateObject("Scripting.Dictionary")
Do While i < sh.Cells(Rows.Count, "AV").End(xlUp).Row
    temp = Cells(i, "AV")
    If Not mondico.exists(temp) Then
        mondico.Add temp, i
        i = i + 1
    Else
        For Each d In mondico.keys
            If d = temp Then
                nulip = mondico.Item(d)
                Exit For
            End If
        Next d
        If sh.Cells(nulip, 3) > sh.Cells(i, 3) Then
            Rows(i).Delete Shift:=xlUp
        Else
            Rows(i).Copy Rows(nulip)
            Rows(i).Delete Shift:=xlUp
        End If
    End If
Loop
Set sh = Nothing
Set mondico = Nothing
Application.ScreenUpdating = True
End Sub

rEVOLV3r · Answer

Merci Beaucoup !
Vous êtes un chef !
J'ai modifié votre macro pour mon application et tout fonctionne bien !
Encore merci !

Je vous souhaite une agréable journée,

rEVOLV3r

Suppression de Doublons avancée

5 réponses

Discussions similaires