cheribibi33
XLDnaute Nouveau
Bonjour,
Dans un fichier Excel j'importe des données d'un logiciel (commande client)
je place les nouvelles données en fin de tableau et je me retrouve avec des lignes identiques en doublon. (colonne A à N)
Je cherche une macro pour supprimer les dernières lignes importées qui sont déjà existant dans mon tableau
Auparavant j'utilisai cette macro ci-après qui fonctionnait très bien : basé sur le numéro de commande (1 seule donnée à chercher)
Maintenant mon export de données est par ligne de commande (donc plusieurs lignes pour la même référence de commande)
Merci
Dans un fichier Excel j'importe des données d'un logiciel (commande client)
je place les nouvelles données en fin de tableau et je me retrouve avec des lignes identiques en doublon. (colonne A à N)
Je cherche une macro pour supprimer les dernières lignes importées qui sont déjà existant dans mon tableau
Auparavant j'utilisai cette macro ci-après qui fonctionnait très bien : basé sur le numéro de commande (1 seule donnée à chercher)
Maintenant mon export de données est par ligne de commande (donc plusieurs lignes pour la même référence de commande)
VB:
Sub doublons()
'Supprimer doublon
Sheets("SUIVI-COMMANDE").Select
choix = InputBox("Avant d'utiliser cet outil, n'oubliez pas d'enregistrer votre fichier !" & Chr(10) & Chr(10) & "Choisissez l'action qui vous intéresse :" & Chr(10) & Chr(10) & "1. Colorer les doublons (colorer la cellule)" & Chr(10) & "2. Colorer les doublons (colorer la ligne entière)" & Chr(10) & "3. Effacer les doublons (en laissant la ligne vide)" & Chr(10) & "4. Supprimer les doublons (ligne entière)" & Chr(10) & "5. Supprimer les lignes vides" & Chr(10) & Chr(10) & "Entrez le n° de l'action et cliquez sur OK :", "Gestion des doublons")
If choix = "" Then Exit Sub
choix2 = ""
If choix = 1 Or choix = 2 Or choix = 3 Or choix = 4 Then choix2 = InputBox("Entrez la lettre de la colonne où les doublons doivent être recherchés : Colonne B", "Gestion des doublons")
If choix = 5 Then choix2 = InputBox("Entrez la lettre de la colonne à prendre en compte (si la cellule de cette colonne est vide, la ligne sera supprimée) : Colonne B", "Gestion des doublons")
If choix2 = "" Then Exit Sub
Application.ScreenUpdating = False
test = Timer
der_ligne = Range(choix2 & "65000").End(xlUp).Row
Dim tab_cells()
ReDim tab_cells(der_ligne - 1)
For ligne = 1 To der_ligne
tab_cells(ligne - 1) = Range(choix2 & ligne)
Next
nb = 0
If choix = 4 Or choix = 5 Then compteur = 0
For ligne = 1 To der_ligne
contenu = tab_cells(ligne - 1)
If (choix = 1 Or choix = 2) And contenu <> "" Then 'Colorer doublons
For i = 1 To der_ligne
If contenu = tab_cells(i - 1) And ligne <> i Then 'Si doublon
nb = nb + 1
If choix = 1 Then
Range(choix2 & ligne).Interior.ColorIndex = 3
Else
Range(ligne & ":" & ligne).Interior.ColorIndex = 3
End If
Exit For
End If
Next
End If
If (choix = 3 Or choix = 4) And ligne > 1 And contenu <> "" Then 'Effacer/supprimer doublons
For i = 1 To ligne - 1
If contenu = tab_cells(i - 1) Then 'Si doublon
nb = nb + 1
If choix = 3 Then
Range(ligne & ":" & ligne).ClearContents
Else
Range(ligne + compteur & ":" & ligne + compteur).Delete
compteur = compteur - 1
End If
Exit For
End If
Next
End If
If choix = 5 And contenu = "" Then 'Lignes vides
Range(ligne + compteur & ":" & ligne + compteur).Delete
compteur = compteur - 1
nb = nb + 1
End If
Next
res_test = Format(Timer - test, "0" & Application.DecimalSeparator & "000")
Application.ScreenUpdating = True
If nb = 0 And choix = 5 Then
dd = MsgBox("Aucune ligne vide trouvée ...", 64, "Résultat")
ElseIf nb = 0 Then
dd = MsgBox("Aucun doublon trouvé dans la colonnne " & UCase(choix2) & " ...", 64, "Résultat")
ElseIf choix = 5 Then
dd = MsgBox(nb & " lignes supprimées (en " & res_test & " secondes)", 64, "Résultat")
ElseIf choix = 4 Then
dd = MsgBox(nb & " doublons supprimés (en " & res_test & " secondes)", 64, "Résultat")
ElseIf choix = 3 Then
dd = MsgBox(nb & " doublons effacés (en " & res_test & " secondes)", 64, "Résultat")
Else
dd = MsgBox(nb & " doublons passés en rouge (en " & res_test & " secondes)", 64, "Résultat")
End If
End Sub
Merci