Supprimer des doublons selon une condition

Bonjour le forum,

Voilà mon problème :

J'ai une liste de machines avec leurs différents critères de dénomination et j'ai des doublons car pour la même machine je peux avoir plusieurs valeurs dans la colonne "cres_fonction".

Mon but est de supprimer les doublons pour n'avoir qu'une seule fois la même machine.

Cette suppression doit se faire suivant les critères suivant:

- Si pour le numéro de matériel "21579" (colonne "mmat_nummat") on a comme choix "DEAT" dans la colonne "cres_fonction", on garde cette ligne et on supprime toutes les autres lignes avec le même numéro de matériel.

- Si nous n'avons pas "DEAT" dans la liste des doublons, on garde la ligne qui contient "DECI" et on supprime les autres

Et ce pour tout les matériels de la feuille ( le fichier joint ne représente qu'une petite partie de mon fichier global)

Tout ça doit se faire dans du code pour effectuer le tri assez vite sur un nombre de lignes conséquent.

Je joint un fichier pour appuyer ma demande.

Je vous remercie d'avance pour votre aide.

Bonjour et bienvenue sur le forum

Un essai à tester. Te convient-il ?

Bye !

Bonjour Renaud09000, le forum,

Salut GMB,

Arggghhh !! ces "tablo".....et en plus tu y mets un dico....

Au top,

Une variante (à tester) à base de tris et filtres (code crée à l'aide de l'enregistreur de macro....)

Sub Suppression()

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

   With Sheets("Feuil1")
    .Range("A2:L" & .Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("L2"), Order1:=xlAscending
    .Range("A2:L" & .Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("B2"), Order1:=xlAscending
    .Range("A2:L" & .Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=12, Criteria1:=Array( _
        "COMPTA", "DEPR", "FACT", "PATR", "="), Operator:=xlFilterValues
    .Range("A2:L" & .Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlVisible).Delete
     If .FilterMode = True Then .ShowAllData
    .Range("A2:L" & .Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
        , 8, 9, 10, 11, 12), Header:=xlYes
    .Range("A2:L" & .Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=2, Header:=xlYes
   End With

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Cordialement,

Bonjour tout le monde,

Merci à GMB et Xorsankukai, les codes sont exactement ce qu'il me fallait.

Je vous remercie pour votre rapidité et efficacité.

Il ne me reste plus qu'à choisir lequel je vais utiliser

Bonne fin de semaine et encore merci.

Désolé le forum, j'ai parlé un peu vite,

En fait, le code de Xorsankukai, fonctionne mais pour les valeurs que j'ai d'unique, il les supprime aussi.

Le but est que dans tout les cas peut importe la valeur de "cres_fonction", j'ai toutes les machines de ma liste de base après exécution de la maccro.

C'est à dire qu'on va prioriser "DEAT", si cette valeur n'y est pas on priorise "DECI", puis "DEPR", puis "PATR", puis "COMPTA" puis "FACT" ,puis " ".

Cette formule me plait car elle filtre les valeurs sur le tableau existant.

Auriez-vous une idée de le façon de modifier le code pour faire ce que je veux?

Je vous remercie d'avance.

Re,

Merci pour ton retour,

Nouvel essai....

Sub suppression_doublons()
 Dim derlig&, plage As Range

 Application.ScreenUpdating = False

    With Sheets("Feuil1")
           derlig = .Range("L" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A2:L" & derlig)
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=Range("L2:L" & derlig), SortOn:=xlSortOnValues, _
          Order:=xlAscending, CustomOrder:="DEAT,DECI,DEPR,PRAT,COMPTA,FACT,", DataOption:=xlSortNormal

        With .Sort
            .SetRange plage
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

         plage.Sort Key1:=Range("B2"), Order1:=xlAscending
        .Range("A1:L" & .Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=2, Header:=xlYes
    End With
End Sub

CTRL + e pour exécuter la macro "suppression_doublons"

Cordialement,

Cela m'a l'air de fonctionner impeccable.

Merci beaucoup pour l'aide je vais gagner pas mal de temps.

Bonne fin de journée,