Suppression Doublon

bonjour a tous

J'intègre un fichier (extraction.xls) tous les jours avec la liste des commandes de J-5 à J+30 pour construire un historique de mes ventes (historique.xlsm)

Tous les jours mon fichier (extraction.xls ) contient 5000 à 10000 lignes. Je precise je n'ai pas la main sur la construction de ce fichier.

Deux spécificités

• Ce fichier contient parfois des lignes parfaitement identiques mais qui ne sont pour autant pas des doublons
• Certaines lignes sont parfois mises à jour et doivent etre ré-intégrée (remonté de poids notament)

Dfficile dans ces conditions de supprimer les doublons (tous les champs etant parfois identique a juste titre).

Pour simplifier j'ai tout mis dans le meme fichier sur deux onglets différents

Pour chaque ligne de l'onglet extraction je controle que le numero de commande (champs A) n'existe pas déjà dans l'onglet historique

S'il existe je supprime la ligne trouvé dans l'onglet historique et je recommence la boucle pour verifier qu'il n'y en a pas d'autre résultat

S'il n'y a pas de résultat, je passe à la ligne suivante (il peux y avoir plusieurs ligne avec le meme num de commande)

With Sheets("extraction")
    DerLigneExtraction = .Cells(Rows.Count, 1).End(xlUp).Row 'derniere ligne de l'onglet extraction
    For i = DerLigneExtraction To 1 Step -1
Boucle:
        Set Cellule = Sheets("historique").Range("A2:A" & DerLigneHisto).Find(.Range("A" & i).Value, lookat:=xlWhole)
        If Not Cellule Is Nothing Then
            Cellule.Rows.EntireRow.Delete
            DerLigneHisto = maDerLigneHisto - 1
            Set Cellule = Nothing
            GoTo Boucle
        End If
    Next i
End With

Une fois que j'ai tout supprime je fais un simple copier coller de extraction vers historique

Mon problème c'est que le traitement "d'extraction des doublons" est très long... Une idée pour faire plus court.

Merci aux petits futés qui pourrons me guider

Bonjour,

il faut trier la liste et faire des comparaisons plus réduites en effet; mais sans voir le code complet et la structure du fichier, difficile de répondre plus précisément (mets un fichier anonymisé).

Bonjour

CI joint le fichier tres épuré

J'ai ajouté quelques lignes de commentaires.

En postant ce message il m'est venu une idée sans doute beaucoup plus simple.

Le fichier extraction est un état des commandes par date d'expédition il me suffit donc de récupérer la date la plus vieille de mon onglet extraction et la date la plus récente et de faire une suppression de toutes les commandes sur l'onglet historique qui sont comprise entre ces deux dates.

Je test ça (ça devrait aller beaucoup plus vite)

J'ai trouvé une solution a peu près convenable

Je poste la solution que j'ai adopté

Un peu moins de 8 sec. pour traiter 10 000 lignes

Sub test()
Application.ScreenUpdating = False
    '[....]
Start = Timer

Sheets("Histo").Select

'definition des variables
Dim DerLigneExtraction As Long, DerLigneHisto As Long, iTemp As Long
Dim Cellule As Range

DerLigneHisto = Range("A" & Rows.Count).End(xlUp).Row 'derniere ligne de l'onglet historique
DerLigneExtraction = Sheets("Extraction").Range("A" & Rows.Count).End(xlUp).Row 'derniere ligne de l'onglet extraction

Dim myRange As Range
Set myRange = Worksheets("Extraction").Range("D7:D" & DerLigneExtraction)
MinDate = Application.Min(myRange)
MaxDate = Application.Max(myRange)

'With Sheets("Histo")

For iSuppDate = DerLigneHisto To 7 Step -1
Set Cellule = Sheets("Histo").Range("D" & iSuppDate)
If (Cellule >= MinDate And Cellule <= MaxDate) Then
            Cellule.Rows.EntireRow.Delete
End If
Next iSuppDate
'End With

'recalcul la derniere ligne
DerLigneHisto = Range("A" & Rows.Count).End(xlUp).Row 'derniere ligne de l'onglet historique

Sheets("Extraction").Range("A7:O" & DerLigneExtraction).Copy
Sheets("Histo").Range("A" & DerLigneHisto + 1).Select
ActiveSheet.Paste
'[.....]
MsgBox (Timer - Start)
End Sub