Pb de condition sur doublons

Bonjour le forum, je suis trés heureux d'etre parmi votre communité. Question, je suis amateur question vba. Je dois construire une base de donnée sur Excel et pour cela je dois enlever les doublons avec la condition de choisir le doublon avec la date la plus petite en colonne E. Pouvez vous SVP me sauver .

Merci d'avance pour votre aide.

J'ai fais la macro pour enlever les doublons mais je n'ai pas integrer la condition par rapport à la date. Vous pouvez changer complétement la macro pour integrer la condition s'il le faut. Je suis la pr apprendre!!! fichier ci-joint.

-- 19 Juin 2010, 15:41 --

am1ne a écrit :

fichier ci-joint.

Excuser moi voila le bon fichier merci d'avance

Bonjour et bienvenue, salut à tous,

Avec filtre élaboré,

la base doit être triée par réf et date

Sub SupprDoublonDate()
'Macros par Claude Dubois pour "am1ne" Excel-Pratique le 20/06/10
Dim Lg%
    Application.ScreenUpdating = False
    Lg = Range("A65536").End(xlUp).Row + 1
    '--- tri ---
    Range("a1:e" & Lg).Sort Key1:=Range("a2"), Order1:=xlAscending, Key2:=Range("e2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1
    '---
    Range("a1:e1").Copy Destination:=Range("g1")
    Cells(2, 6) = "=and(a2<>a3,Max(e2:e3))"
    Cells(Lg, 5) = Cells(Lg - 1, 5)
    Range("a1:e" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("f1:f2"), CopyToRange:=Range("g1:k1"), Unique:=False
    Cells(Lg, 5).ClearContents
    Columns("a:f").Delete
    Columns("a:e").AutoFit
End Sub

édit: incorporé le tri

Amicalement

Claude

Bonjour Claude, merci beaucoup pour ton aide. Je n'ai pas compris tout dans ton code mais il ne donne pas les articles en colonne A avec la date la plus petite j'ai essayé de changer Max par min dans ton code mais ca marche pas

Normalement on devrait avoir

M523P569820000 22/12/2008

M523P574800000 07/07/2010

M523P574900000 07/07/2010

M523P581900000 07/07/2010

M523Q702300010 21/06/2010

M523Q702300110 21/06/2010

Sachant que j'ai plein de fichiers comme celui que je t'ai donné ou je peux avoir a la dernière ligne a la colonne A une cellule vide ou pas et/ou des cellules vides en colonne A en milieux de cellules pleines.

Merci encore pour ton aide précieuse.

Bonsoir,

Il paraissait logique de garder la date la + récente, mais bon !

inverse l'ordre de tri (2ème clé Descending)

    '--- tri ---
    Range("a1:e" & Lg).Sort Key1:=Range("a2"), Order1:=xlAscending, Key2:=Range("e2") _
    , Order2:=xlDescending, Header:=xlYes, OrderCustom:=1
    '---

Maintenant pour les cellules vides en colonne A, vaudrait mieux supprimer la ligne

Confirme

Amicalement

Claude

Merci merci et encore merci Claude!!! la macro fonctionne trés bien. J'espere ma'meliorer en vba et contribuer a mon tour sur le forum.

Bonjour,

----- Remarque sur la macro -----

Comme tu dis avoir des cellules vides en colonne A (et peut-être la dernière)

tu dois initialiser la variable "Lg" sur une colonne complète (ici colonne "E")

Lg = Range("e65536").End(xlUp).Row + 1

le .Row + 1, parce-que dans le critère, tu compare une ligne avec celle du dessous

pour supprimer lignes si vide en colonne A

On Error Resume Next
Range("a2:a" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

on met la gestion d'erreur car bogue si pas de vide.

dans la formule critère, le Max ou Min ne sert à rien, donc :

Cells(2, 6) = "=a2<>a3"

------- le code complet devient -------

Sub SupprDoublonDate()
'Macros par Claude Dubois pour "am1ne" Excel-Pratique le 21/06/10
Dim Lg%
    Application.ScreenUpdating = False
    Lg = Range("e65536").End(xlUp).Row + 1
    On Error Resume Next
    Range("a2:a" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    Lg = Range("e65536").End(xlUp).Row + 1
    '--- tri ---
    Range("a1:e" & Lg).Sort Key1:=Range("a2"), Order1:=xlAscending, Key2:=Range("e2") _
    , Order2:=xlDescending, Header:=xlYes, OrderCustom:=1
    '---
    Range("a1:e1").Copy Destination:=Range("g1")
    Cells(2, 6) = "=a2<>a3"
    Cells(Lg, 5) = Cells(Lg - 1, 5)
    Range("a1:e" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("f1:f2"), CopyToRange:=Range("g1:k1"), Unique:=False
    Cells(Lg, 5).ClearContents
    Columns("a:f").Delete
    Columns("a:e").AutoFit
End Sub

Pour clôturer le poste, c'est ici

Claude