Doublons_et_lignes_vides

Le 07/05/2020 à 23:42

bonsoir

macro fabuleuse

j utillise cette macro géniale pour mon nouveau fichier Excel

pour mon fichier je voudrai juste avoir la solution 4 en permanence(ne plus avoir a choisir) et ne pas choisir la colonne à chaque fois ( la mettre en dur dans la macro)

cela fait 4 heures que le bidouille sans aucun résultat........

merci

Sub doublons_et_lignes_vides()

    'Macro : Sébastien Mathier - Excel-Pratique.com
    'A propos de cette macro : 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 08/05/2020 à 00:13

Bonjour,

Sub doublons_et_lignes_vides()

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

    choix = 4   ''' 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")
    choix2 = "E"    ' << ici colonne E <<< à adapter

'''    If choix2 = "" Then Exit Sub
    ...
    ...
    ...
    ..

ric

Le 08/05/2020 à 10:14

bonjour

merci pour l info

une dérnière question toujours pour la même macro

je copie la macro sur 2 fichiers différent avec la même liste de doublons à chercher

dans le premier elle marche bien ce fichier ne contient pas d autre macro

dans le 2em il y a des macros et la elle pédale pendant 30 secondes environ

bonne journée

Le 08/05/2020 à 11:27

Bonjour,

Parmi les autres macros, il doit y avoir une ou des macros événementielles (qui sont déclenchées automatiquement) du genre ... Private Sub Worksheet_Change(ByVal Target As Range).

, c'est bien décrit comment faire pour contourner temporairement.

ric

Le 08/05/2020 à 11:51

bien vue j ai bien cette commande

j'ai fais comme l'exemple

sous le nom de la macro j'ai collé

Application.EnableEventsúlse

et au dessus de end sub

True

maintenant j'ai une "erreur de compilation erreur de syntaxe"

Le 08/05/2020 à 12:09

Bonjour,

Il y a une erreur d'écriture sur le site Web. ... désolé

La commande est : Application.EnableEvents = False

et Application.EnableEvents = True

ric

Le 08/05/2020 à 17:20

merci il n y a plus le message d erreur

il faut toujours sortir les rames

Le 08/05/2020 à 17:23

Bonjour,

Est-ce possible d'avoir le fichier ? Même sans données ... pour les macros...

ric

Le 08/05/2020 à 21:39

bonsoir

la feuille ou il y a la macro et la feuille "recap"

clic sur la case "tableau" puis sur la case "doublons"

voici e fichier

bons soirée

Le 09/05/2020 à 00:41

Bonjour,

Voici ton fichier en retour ...

J'ai fait des boucles au lieu de longues listes ... entre autres au Module10 et au module2.

Dis-moi s'il y a amélioration zou pas.

Si zou pas, même temps ? Un peu plus rapide ? Plus lent ?

Mais j'avoue que je pense qu'il serait possible d'améliorer le traitement des doublons.

ric

Le 09/05/2020 à 09:29

je dirais aucun changement

désoler

je vais essayé en copiant le tableau dans un autre fichier excel et de renvoyer les info trie dans le fichier principal

vous voyez une autre solution?

bonne journée

Le 09/05/2020 à 10:20

Bonjour,

Je regarde pour un autre code de tri.

ric

Le 09/05/2020 à 11:06

Bonjour,

J'ai adapté un code de Jacques Boisgontier.

C'est ultra rapide ...

Sub doublons_et_lignes_vides()
'' source : http://boisgontierjacques.free.fr
    With Sheets("recap")
        Set d = CreateObject("Scripting.Dictionary")
        Set début = .Cells(32, "Y")
        a = .Range(début, début.End(xlDown))
        For Each c In a
            d(c) = ""
        Next c
        .Range(début, début.End(xlDown)).ClearContents
        début.Resize(d.Count, 1) = Application.Transpose(d.keys)

        '' repasse une 2e fois pour enlever les 0
        Set d = Nothing
        Set d = CreateObject("Scripting.Dictionary")
        Set début = .Cells(32, "Y")
        a = .Range(début, début.End(xlDown))
        For Each c In a
            If c <> 0 Then d(c) = ""
        Next c
        .Range(début, début.End(xlDown)).ClearContents
        début.Resize(d.Count, 1) = Application.Transpose(d.keys)
    End With
End Sub

ric

Le 09/05/2020 à 11:22

bonjour

Le 09/05/2020 à 22:56

génial 4 secondes pour copie mettre sur 1 colonne gestion des doublons

merci merci

trop fort

Le 09/05/2020 à 23:02

Bonjour,

Je suis bien heureux de ta satisfaction de la façon dont ton souci s'est évanoui.

trop fort > c'est pour Jacques Boisgontier qui a mis à disposition autant de matériel.

ric

Rechercher des sujets similaires à "doublons lignes vides"