VBA pb Macro pr trouver et supprimer des doublons entre 2 feuilles excelRésolu/Fermé

Question

Bonjour,

Je m'adresse a vous car j'ai un petit souci avec mon code. 
Son objectif est de comparer ligne par ligne 2 colonnes ds 2 feuilles differentes. si dans la feuille "New Data" une des donnees sur une ligne correspond a celle dans la feuille "data Base" alors cette ligne sera supprimer ds "New Data".

Cette macro fonctionne bien mis a part le fait qu'elle ne semble pas prendre en compte toutes les lignes lors d'un 1er passage. je dois l'executer plusieurs fois avant qu'elle ne detecte toutes les lignes communes entre les 2 feuilles excel.

Avez vous une idee pourquoi ca fait ca et comment resoudre ce pb.

Merci d'avance pr votre aide:

cf mon code ci-dessous

Sub comparedata()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim RowNo As Long

    
    Set rng1 = Worksheets("New Data").Range("A6", Worksheets("New Data").Range("A" & Rows.Count).End(xlUp))
    Set rng2 = Worksheets("Database").Range("A6", Worksheets("Database").Range("A" & Rows.Count).End(xlUp))
    For Each c In rng1
       If Application.WorksheetFunction.CountIf(rng2, c) > 0 Then
            Range(c, c.Offset(, 100)).Delete
            

        End If
    Next c
End Sub

cs_Orohena · Accepted Answer

Salut Nibor332

Ta remarque est pertinente, mon code manque de logique puisque la première boucle compare deux feuilles nommées, tandis que la deuxième travaille sur la feuille active ! Il faut, pour être logique, remplacer :
Range(Cells(liste(i), 1), Cells(liste(i), 100)).Delete
par
Worksheets("Feuil1").Range(Cells(liste(i), 1), Cells(liste(i), 100)).Delete
Amicalement

cs_Orohena · Answer

Bonjour Nibor332

Peut-être cela vient-il du fait que tu modifies la source de données de la boucle For Each tout en l'exécutant.
Peux-tu essayer ce code ? Il fait d'abord le For Each puis supprime les cellules.

Option Explicit
Sub comparedata()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim RowNo As Long
    Dim liste() As Integer
    Dim c As Range
    Dim i As Integer
    Set rng1 = Worksheets("Feuil1").Range("A6", Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp))
    Set rng2 = Worksheets("Feuil2").Range("A6", Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp))
    ReDim liste(0)
    For Each c In rng1
       If Application.WorksheetFunction.CountIf(rng2, c) > 0 Then
            ReDim Preserve liste(UBound(liste) + 1)
            liste(UBound(liste)) = c.Row
        End If
    Next c
'
    For i = UBound(liste) To 1 Step -1
        Range(Cells(liste(i), 1), Cells(liste(i), 100)).Delete
    Next
End Sub

Amicalement

Nibor332 · Answer

Salut Orohena,

Merci bcp pour ta reponse. En effet, ton code est tres astucieux. Je viens de le tester et il fonctionne tres bien mais 
Il y a juste un petit detail qui m'echape qui est le suivant:

En fonction de la feuille dans laquelle je suis qd j'execute la macro, il va comparer la feuille dans laquelle je suis contre l'autre et effacer les donnees de la feuille dans laquelle je suis. or, je veux que cela fonctionne seulement dans un sens cad que j'ai une feuille avec ma base de donne qui reste fixe, et l autre feuille contient les donnees a comparer et effacer si il y a des doublons. 
A terme, je voudrais lier la macro a un bouton et il faudrait que la macro comprennent quelle feuille il doit comparer. 
et pour le moment la macro ne s'execute que dans la feuille dans laquelle je me trouve meme si je la lie a un bouton dans une nouvelle feuille.

Je vais a chercher une solution de mon cote mais toute aide est la bienvenue sur le sujet :)

Cordialement,

Nibor332 · Answer

Hello Orohena,

Merci pour ton aide.
Pour une raison que je ne comprend pas mettre seulement :
Worksheets("Feuil1").Range(Cells(liste(i), 1), Cells(liste(i), 100)).Delete
fait bugger la macro 

Je contourne le pb en mettant 
Worksheets("Feuil1").activate
Worksheets("Feuil1").Range(Cells(liste(i), 1), Cells(liste(i), 100)).Delete

et ca fonctionne nikel :)

Je te remercie a nouveau pour ton aide precieuse

Passe un tres bon week end!

Nibor

VBA pb Macro pr trouver et supprimer des doublons entre 2 feuilles excel

4 réponses

Discussions similaires