Suppression de doublons en VBA

Bonjour à tous,

Après maintes recherches je n'ai pas réussi à trouver l'assistance qu'il me fallait pour mon problème donc je vous me permet sollicite.

J'ai le code suivant que j'ai récupéré ici-même et que j'ai adapté légérement à ma sauce afin de pouvoir sélectionner quelles cellules copié avant de les supprimer et où. Ce code marche parfaitement sur une centaine de valeur mais il s'avère que mon fichier en comporte 1300 et qu'avec ce nombre de valeurs, excel plante. Afin de pouvoir m'en servir je commence par passer les valeurs qui sont positives et négatives en valeur absolue avec un code qui fonctionne très bien et ensuite mon objectif serait avec celui-ci de pouvoir copier les doublons afin de garder une trace de ceux-ci et les supprimer dans mon tableau, je pensais donc réaliser un 3ème code dans le but de supprimer les cases vide de mon tableau via un troisième bouton mais si vous avez une solution pour le faire en one shot ça m'avancerais beaucoup.

Voici mon code:

Sub doublons_et_lignes_vides()

    'Macro : S�bastien Mathier - Excel-Pratique.com
    'A propos de cette macro : www.excel-pratique.com/fr/blog/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 et les dupliquer en colonne M" & 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 :", "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) :", "Gestion des doublons")
    If choix2 = "" Then Exit Sub

    If choix = 3 Then
        choix3 = InputBox("Dans quelle colonne souhaitez-vous copier les doublons avant de les supprimer:")
    End If

    Application.ScreenUpdating = False
    test = Timer

    der_ligne = Range(choix2 & Rows.Count).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(choix2 & ligne).Select
                        Range(choix2 & ligne).Copy (Cells(ligne, choix3))
                        Range(choix2 & 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
        MsgBox "Aucune ligne vide trouv�e ...", 64, "R�sultat"
    ElseIf nb = 0 Then
        MsgBox "Aucun doublon trouv� dans la colonnne " & UCase(choix2) & " ...", 64, "R�sultat"
    ElseIf choix = 5 Then
        MsgBox nb & " lignes supprim�es (en " & res_test & " secondes)", 64, "R�sultat"
    ElseIf choix = 4 Then
        MsgBox nb & " doublons supprim�s (en " & res_test & " secondes)", 64, "R�sultat"
    ElseIf choix = 3 Then
        MsgBox nb & " doublons effac�s (en " & res_test & " secondes)", 64, "R�sultat"
    Else
        MsgBox nb & " doublons pass�s en rouge (en " & res_test & " secondes)", 64, "R�sultat"
    End If

End Sub

Je vous rajoute également mon code pour la mise en Valeur Absolue, si vous avez des idées ou des conseils:

Sub G�rer_Va_Abs()

choix1 = InputBox("N'h�sitez pas � enregistrer vos documents avant de vous servir de cet outil" & Chr(10) & Chr(10) & "Tapez le nom de la colonne sur laquelle travailler:")
choix2 = InputBox("Tapez le nom de la colonne dans laquelle coller les nouvelles donn�es:")
der_ligne = Range(choix1 & Rows.Count).End(xlUp).Row
Dim ligne As Integer

    For ligne = 2 To der_ligne

    cellule = ActiveWorkbook.Sheets("KPMG_1502").Cells(ligne, choix1).Value

        If cellule <> "" Then

            cellule_s = ActiveWorkbook.Sheets("KPMG_1502").Cells(ligne, choix2).Select
            ActiveWorkbook.Sheets("KPMG_1502").Cells(ligne, choix2).Value = Abs(cellule)

        Else: Exit Sub

        End If
    Next ligne

End Sub

Bonne soirée à vous les experts et merci d'avance pour vos réponses.

Bonsoir Luane, bonsoir le forum,

Pas de réponse, juste une demande : le fichier qui va bien !
Il nous faut tester avant de répondre et pour tester il faut un fichier...

Bonjour ThauThème, Bonjour le forum.

Tout d'abord merci pour ta réponse, voici le document qui ne comporte pas les 1300 lignes car c'est le document de test mais le code ne fonctionne pas dessus non plus...

Au delà de supprimer les doublons, je souhaiterais supprimer les 2 valeurs identiques et pas seulement le doublons et les coller toutes les deux dans une colonne à côté afin de ne pas perdre les valeurs tout de même.

Un deuxième problème vient de se poser à moi, en effet, si je me retrouves avec trois fois la même valeur ou des doublons par rapport à des codes différents, cela va me supprimer les deux alors qu'ils ne correspondent pas au même code (Colonne D) ce qui pose problème pour le coup, si jamais vous avez des solutions pour cela aussi je suis preneur.

Je vous joins donc le document pour que vous puissiez effectuer des tests, merci encore pour votre aide.

Bon week-end à vous.

Re,

Tableau fourni bien trop nul pour effectuer des tests concluants !...
En pièce jointe ton fichier modifier avec une UserForm. Clique sur le bouton... Code commenté pour te permettre de modifier toi-même car je n'y reviendrai pas vu le peu d'efforts que tu daignes fournir pour nous permettre de t'aider.

Bonjour ThauThème, tout d'abord merci pour ta réponse et ton temps.

Cependant je vais t'éclairer sur le pourquoi du comment.

Pour commencer je suis novice en VBA (a vrai dire j'ai du commencer il y a 2 semaines) et je n'ai pas non plus une grande habitude des forums, mais peu importe. Je travail pour une entreprise et les documents sur lesquels je travaillent sont confidentiels, c'est simplement pour cette raison que je peux pas les transmettre et je pense que tu peux le comprendre. Donc ce n'est clairement pas un manque d'envie ou "d'efforts" mais simplement un problème logistique, pour ce qui est du tableau que je t'ai fournis, j'ai eu le même problème sur celui-ci que j'ai créé pour faire mes tests et pouvoir vous les transmettre donc pour moi il était assez fourni, il suffit donc de me le dire que je puisse l'étoffer et me dire ce qu'il faut changer sur ce document pour que je le fasse. Bien sur la mise en page est précaire car je n'en avais pas besoin mais je ferais quelque chose de plus soigné à vous transmettre Lundi.

Encore une fois merci pour ton temps passé et j'espère que nous aurons encore l'occasion d'échanger, j'ai vu que tu était un des acteur principal de ce forum lorsque j'ai fait mes recherches.

Bonne journée.

Re,

Faux problème que celui de la confidentialité. En effet, il est extrêmement simple et rapide avec Excel de créer une fausse base de données de quelques lignes anonymes et reprenant la structure de ton fichier original...

Je ne connais donc pas cette fonctionnalité, j'avoue avoir passé beaucoup de temps à taper les quelques 200 lignes contenu sur le fichier que je t'ai envoyé...

Je suis vraiment un novice d'excel pas seulement de VBA...

Bonjour Thau-Thème, bonjour le forum.

C'est bon j'ai trouvé comment modifier ma BDD afin d'en faire quelque chose de bien plus exploitable et basé sur ma BDD originale.

Merci pour ton code Thau Thème, c'est bien mieux avec un Userform je n'y avait même pas pensé et les explications sont très clairs !

Mon principal problème maintenant c'est d'arriver à supprimer le doublon mais également la valeur original du doublons mais tout en restant en adéquation avec les codes déclarant et tiers. En effet, si d'autres code ont le même montant de transaction mais sont avec des codes différents, ils ne doivent pas être supprimer tant qu'il n'y a pas de doublons avec ces codes. C'est un peu compliqué mais je vais imager:

125 fait un transfert a 254 de 12 547.58

Si 254 a un transfert de -12 547.58 envers 125 alors

Je veux supprimer ces deux valeurs et les lignes mais les copier à côté pour les conserver tout de même.

En revanche si 125 à un transfert de 5000 envers 254

et 145 de 5000 ou (-5000) envers 200 alors les lignes ne doivent pas être supprimer.

J'ai l'impression de beaucoup en demander et j'ai du mal à trouver les solutions à mes problèmes, ci-joint la BDD.

Merci encore pour vos réponses et l'aide que vous pourrez m'apporter, bonne journée.

Bonjour Luane, bonjour le forum,

C'est bien trop compliqué pour que je m'y attaque... En plus, j'ai repris le boulot et je n'ai plus autant de disponibilité. Désolé, j'espère que tu trouveras de l'aide.

Bonjour à tous,

Pas de soucis ThauThème, bon courage pour ta reprise !

Bonne journée à tous.

Bonjour,

je m'étais permis de suivre le sujet au cas où, je vais essayer de m'imprégner de la problématique, la seule feuille avec laquelle on va travailler à présent c'est "feuille 2" qui est une version améliorée de "feuille 1", c'est bien ça?

Si c'est ça, pour feuille 2 tu aimerais archiver quelque part les opérations qui s'annulent, si on transfère 100€ du Code A 125 vers le Tiers 100, et qu'on transfère à nouveau 100€ du code A 100 vers le Tiers 125 par exemple?

N'hésite pas à me dire si je me trompe, mais du coup on aurait besoin de comparer les soldes en fonction de code a et tiers, le nom ne servirait pas au traitement des infos?

Bonjour Ausecour,

C'est exactement ça, le but étant de retrouver les transferts qui s'annulent dans un optique de trouver ou ils ne s'annulent pas et de trouver l'écart entre ce qui est reçus et ce qui est envoyé. C'est une manière de repérer les erreurs dans les virements intercomptes de l'entreprise.

Mais tu as très bien résumé mon problème, aujourd'hui tout est fait à la main via un TCD et j'aimerais automatiser cette démarche.

Merci pour vote aide,

Bonne journée.

Rebonjour,

J'ai tout codé mais j'ai l'impression que le tableau donné ne contient aucun cas cité précédemment, j'ai donc rajouté une ligne bidon en ligne 1297 pour qu'au moins deux transferts s'annulent, je joins le résultat.

Re Ausecour,

Merci beaucoup pour ce code qui m'a l'air tout à fait incroyable, je viens de voir mon erreur qui fait qu'en effet il n'y a pas de cas énoncé dans ce tableau, je t'ai refait du coup le document, cela parrait fonctionner cependant il y a encore des doublons qu'il reste par exemple Lorsque tu filtre et met 250 et 310 en tiers tu vois qu'il reste la même valeur positive et négative, j'ai cherché pourquoi mais j'ai pas trouvé...

Je te met un screen de ce que je veux dire et bien sur le nouveaux document.

C'est peu être de ma faute et que j'ai mal expliqué mon problème je ne sais pas mais en tout cas merci beaucoup déjà pour ce super code !

Re,

Ah c'est normal, ce n'est pas tout à fait la même valeur, il y a une différence au niveau des centimes.

Est-ce qu'on considère quand même que ce sont les mêmes valeurs? Si oui j'adapterai le code, ça ne demandera pas beaucoup de modifications.

Bonjour Ausecour, bonjour le forum,

Je dois dire bravo et merci pour tout mon ami, tu as réglé mon problème et rapidement en plus. Merci encore, ce programme va nous faire gagner de précieuses heures !

Agréable journée !

Bonjour,

pour revenir à ma question, on prend les centimes en compte pour la comparaison? je n'ai pas eu de réponse...

Content que ça vous fasse gagner du temps

Excusez-moi pour ne pas avoir répondu, non oui on les prend en considération. Le problème, si on peut appeler ça comme ça vient du fait que le programme est beaucoup plus précis que l’humain et reporté des exactitudes au centimes près ce qu’on ne faisait pas forcément à la main !

Merci encore !

D'accord, ce n'est donc pas un problème mais une amélioration!

Bonne journée!