Choix de la première et dernière ligne - gestion de doublons

Le 05/12/2012 à 09:35

J'utilise la macro suivante : Solution pratique pour gérer les doublons et les lignes vides venant de ce site https://www.blog-excel.com/gerer-doublons-et-lignes-vides/

Je dois en fait gérer les doublons de matériel sur plusieurs lieux et sur plusieurs jours. En gros, je dois recommencer ma manipulation sur plusieurs colonnes mais également sur la même colonne plusieurs fois.

Dans le code VBA, je n'ai pas la possibilité de laisser à l'utilisateur le soin de donner la première ligne et la dernière ligne à vérifier (elles vont varier à chaque fois).

Comment pourrais-je donc lui siginifier ? Merci d'avance

Sub doublons_et_lignes_vides()

    'Macro : Sébastien Mathier - Excel-Pratique.com
    'A propos de cette macro : http://www.blog-excel.com/gerer-doublons-et-lignes-vides/

    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 - Blog-Excel.com")
    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 :", "Gestion des doublons - Blog-Excel.com")
    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) :", "Gestion des doublons - Blog-Excel.com")
    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
Le 05/12/2012 à 10:11

Bonjour,

L'utilisateur peut choisir la première et dernière ligne à traiter.

S'il ne donne aucune indication, on balaye toute la colonne.

    Sub doublons_et_lignes_vides()

        'Macro : Sébastien Mathier - Excel-Pratique.com
        'A propos de cette macro : http://www.blog-excel.com/gerer-doublons-et-lignes-vides

        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 - Blog-Excel.com")
        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 :", "Gestion des doublons - Blog-Excel.com")
        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) :", "Gestion des doublons - Blog-Excel.com")
        If choix2 = "" Then Exit Sub

        Application.ScreenUpdating = False
        Test = Timer

        prem_ligne = InputBox("Entrez le numéro de la première ligne où les doublons doivent être recherchés :", "Gestion des doublons - Blog-Excel.com")
        der_ligne = InputBox("Entrez le numéro de la dernière ligne où les doublons doivent être recherchés :", "Gestion des doublons - Blog-Excel.com")
        If prem_ligne = "" Then prem_ligne = 1
        If der_ligne = "" Then der_ligne = Range(choix2 & "65000").End(xlUp).Row

        Dim tab_cells()
        ReDim tab_cells(der_ligne - 1)

        For ligne = prem_ligne 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

A+

Le 05/12/2012 à 10:25

Parfait ! Cela marche super bien ...

Merci beaucoup

Rechercher des sujets similaires à "choix premiere derniere ligne gestion doublons"