Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 VBA supprimer doublon lignes identiques

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)

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
 

Paritec

XLDnaute Barbatruc
bonjour Cheribibi33 le forum
tu nous mets un bout de ton fichier et je vais te faire cela.
mais tu es sur que ce sont les dernières lignes qu'il faut supprimer et non pas les anciennes lignes de ton fichier???
à mon avis si les lignes ont étés modifiées, tes lignes à jours sont les dernières et non les premières!!!
à te relire
a+
Papou
 

cheribibi33

XLDnaute Nouveau
Bonjour merci pour votre réponse,
J'importe des données tous les jours dans une feuille A (qui me sert de dépôt et vidé après) puis je veux les copier dans ma feuille SUIVI-COMMANDE qui contient déjà des données importé.
Ce que je veux, c'est importer que les lignes commandes de la feuille A qui ne sont pas présentes dans la feuille SUIVI-COMMANDE.
 

Discussions similaires

Réponses
4
Affichages
450
Réponses
7
Affichages
686
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…