comparer deux feuilles et supprimer les données communes

[philmaure]

Bonjour à tous,

chaque jours j'extrais une liste.
Je souhaiterai pouvoir comparer les listes à deux dates différentes et supprimer les données communes.
Le but est de laisser sur le fichier le plus récents les nouvelles données.
Merci d'avance
Philippe

 

[KenDev]

Re : comparer deux feuilles et supprimer les données communes

Bonjour Philippe ,

Ci-joint un fichier selon ce que j'ai compris.

J'ai traduis 'et supprimer les données communes' par 'et supprimer un des deux exemplaires des données en doublon', j'ai bon ?

Si le nombre de colonne vient à varier un jour il suffira de modifier la ligne Const Ccol% = 10 en conséquence.

J'ai anonymisé les noms de famille... Pas de données confidentielles dans les classeurs postés svp.

Pour supprimer les deux feuilles synthétisées en fin de macro remplacer false par true dans la ligne
Call Keep1(n, False)

Cordialement

KD

Option Explicit

Const Ccol% = 10

Sub LaunchKeep()
Dim n$(1 To 2), b%, i%, j%
For i = 1 To 2
    b = False
    n(i) = Application.InputBox("Nom de la feuille numéro " & i & " ?")
    For j = 1 To Worksheets.Count
        If Worksheets(j).Name = n(i) Then
            b = True
            Exit For
        End If
    Next j
    If b = False Then
        MsgBox "Feuille non trouvée"
        Exit Sub
    End If
Next i
Call Keep1(n, False)
End Sub

Sub Keep1(n$(), Sup%)
Dim Ws(1 To 2) As Worksheet, r1&, tb(), i&, j%, r2&, b%, k%, Sy As Worksheet
For i = 1 To 2
    Set Ws(i) = Worksheets(n(i))
Next i
Sheets.Add
Set Sy = ActiveSheet
r1 = Ws(1).Cells(Rows.Count, 1).End(xlUp).Row
Ws(1).Range(Ws(1).Cells(1, 1), Ws(1).Cells(r1, Ccol)).Copy _
    Destination:=Sy.Cells(1, 1)
ReDim tb(2 To r1, 1 To Ccol)
For i = LBound(tb) To UBound(tb)
    For j = 1 To Ccol
        tb(i, j) = Sy.Cells(i, j)
    Next j
Next i
r2 = r1
For i = 2 To Ws(2).Cells(Rows.Count, 1).End(xlUp).Row
    For j = LBound(tb) To UBound(tb)
        b = True
        For k = 1 To Ccol
            If Ws(2).Cells(i, k) <> tb(j, k) Then
                b = False
                Exit For
            End If
        Next k
        If b Then Exit For
    Next j
    If Not b Then
        r2 = r2 + 1
        Ws(2).Range(Ws(2).Cells(i, 1), Ws(2).Cells(i, Ccol)).Copy _
                Destination:=Sy.Cells(r2, 1)
    End If
Next i
If Sup = True Then
    Application.DisplayAlerts = False
    For i = 1 To 2
        Ws(i).Delete
    Next i
    Application.DisplayAlerts = True
End If
End Sub

 

[Habitude]

Re : comparer deux feuilles et supprimer les données communes

Bonjour à tous

Voici un fichier qui ne conserve que les nouvelles entrées

j'ai ajouté une barre d'outil avec combobox
Qui permet de retirer de la feuille active, la feuille choisi dans le combobox.

 

[Grand Chaman Excel]

Re : comparer deux feuilles et supprimer les données communes

Bonsoir philmaure, KenDev

Voici ma proposition. Il faut sélectionner la 1re cellule de chaque tableau (récent et ancien). Ici ce serait A2. Ensuite, la macro crée 2 tableaux contenant les données des 10 colonnes, le tout est concaténé. Ensuite, on compare les 2 tableaux ensemble et on identifie les lignes "doublon" pour ensuite les effacer dans l'onglet le plus récent.

Sub Compare2Listes()

Dim p1 As Range, p2 As Range
Dim Tablo1() As Variant, Tablo2() As Variant
Dim i As Integer, j As Integer, k As Integer

On Error Resume Next

'Choisir la première cellule de chaque tableau de données
'Par exemple ici on choisirait A2 dans 20 06 2011
'et ensuite A2 dans 19 06 2001
'on suppose qu'il n'y a pas de lignes vides ou de données sous les tableaux
'
Set p1 = Application.InputBox("1re cellule du tableau le plus récent", , , , , , , 8)
Set p2 = Application.InputBox("1re cellule du tableau ancien", , , , , , , 8)

Application.ScreenUpdating = False

'Creation des tableaux contenant les données
i = p1.Offset(10000, 0).End(xlUp).Row - p1.Row + 1
j = p2.Offset(10000, 0).End(xlUp).Row - p2.Row + 1

ReDim Tablo1(1 To i)
ReDim Tablo2(1 To j)

'1er tableau (récent)
For i = 1 To UBound(Tablo1())
    Tablo1(i) = ""
    For k = 0 To 9      '9 car dernière colonne = J (10)
        Tablo1(i) = Tablo1(i) & p1.Offset(i - 1, k) & "|"
    Next k
Next i

'2e tableau (ancien)
For i = 1 To UBound(Tablo2())
    Tablo2(i) = ""
    For k = 0 To 9
        Tablo2(i) = Tablo2(i) & p2.Offset(i - 1, k) & "|"
    Next k
Next i

'recherche des données communes entre les 2 tableaux
For i = 1 To UBound(Tablo1())
    For j = 1 To UBound(Tablo2())
        If Tablo1(i) = Tablo2(j) Then Tablo1(i) = "Doublon"
    Next j
Next i

'Effacer les lignes communes
For i = UBound(Tablo1()) To 1 Step -1
    If Tablo1(i) = "Doublon" Then
        p1.Offset(i - 1, 0).EntireRow.Delete
    End If
Next i

Application.ScreenUpdating = True

End Sub

En espérant que ça t'aide un peu...
A+

Edit : Bonsoir Habitude... J'aime beaucoup ta solution. Je garde ça en banque.

 

[Habitude]

Re : comparer deux feuilles et supprimer les données communes

Bonsoir Chaman

Ton code ressemble beaucoup au mien.
A la différence près que tu supprime les lignes alors que j'écrase les valeurs avec un nouveau tableau.

J'ai développé cette méthode car j'en avais asser des #ref dans mes formules

 

[philmaure]

Re : comparer deux feuilles et supprimer les données communes

Bonjour et merci à vous deux.

J'ai teste la méthode de KenDev mais cela me crée une feuille avec beaucoup trop de données car il reste des données présentent dans les 2 feuilles d'oirgine (boir fichier joint)

Quant à la solution d'Habitude, je n'ai pas compris comment cela fonctionne. J'ai bien vu la barre mais quel est le principe ?

Merci pour vos réponses.
Cdlt
philippe

 

[philmaure]

Re : comparer deux feuilles et supprimer les données communes

re-bonjour
j'ai fini par comprendre la solution d hatitude
c'est genial et cela me convient parfaitement
merci a vous deux
philippe

 

[KenDev]

Re : comparer deux feuilles et supprimer les données communes

Bonjour à tous,

Ben j'arrive trop tard J'avais donc dans mon 1er post mal traduit...

Cordialement

KD

La correction quand même

Option Explicit

Const Ccol% = 10

Sub LaunchKeep()
Dim n$(1 To 2), b%, i%, j%
For i = 1 To 2
    b = False
    n(i) = Application.InputBox("Nom de la feuille numéro " & i & " ?")
    For j = 1 To Worksheets.Count
        If Worksheets(j).Name = n(i) Then
            b = True
            Exit For
        End If
    Next j
    If b = False Then
        MsgBox "Feuille non trouvée"
        Exit Sub
    End If
Next i
Call Keep1(n, False)
End Sub


Sub Keep1(n$(), Sup%)
Dim Ws(1 To 2) As Worksheet, r&(1 To 3), tb(), i&, j%, c%, k%, Sy As Worksheet

For i = 1 To 2
    Set Ws(i) = Worksheets(n(i))
Next i

Sheets.Add
Set Sy = ActiveSheet

For i = 1 To 2
    r(i) = Ws(i).Cells(Rows.Count, 1).End(xlUp).Row
Next i

ReDim tb(2 To r(1) + r(2) - 1, 1 To Ccol + 1)

For i = LBound(tb) To UBound(tb)
    For j = 1 To Ccol
        If i < r(1) + 1 Then
            tb(i, j) = Ws(1).Cells(i, j)
        Else
            tb(i, j) = Ws(2).Cells(i - r(1) + 1, j)
        End If
    Next j
    tb(i, Ccol + 1) = True
Next i

For i = LBound(tb) To r(1)
    For j = r(1) + 1 To UBound(tb)
        c = 0
        For k = 1 To Ccol
            If tb(i, k) = tb(j, k) Then
                c = c + 1
            End If
            If c = Ccol Then
                tb(i, Ccol + 1) = False
                tb(j, Ccol + 1) = False
            End If
        Next k
    Next j
Next i

r(3) = 1

For i = LBound(tb) To UBound(tb)
    If tb(i, Ccol + 1) = True Then
        r(3) = r(3) + 1
        For j = 1 To Ccol
            Sy.Cells(r(3), j) = tb(i, j)
        Next j
    End If
Next i

Ws(1).Range(Ws(1).Cells(1, 1), Ws(1).Cells(1, Ccol)).Copy _
    Destination:=Sy.Cells(1, 1)
    
Sy.Columns.AutoFit

If Sup = True Then
    Application.DisplayAlerts = False
    For i = 1 To 2
        Ws(i).Delete
    Next i
    Application.DisplayAlerts = True
End If

End Sub

 

[jb.antichan]

Re : comparer deux feuilles et supprimer les données communes

Bonjour à tous !

Nouveau sur ce forum, je souhaiterai revenir sur post. En effet, étant un véritable novice dans le langage VBA, et après plusieurs heures de recherche sur des forums divers et varié, je suis tombé sur la solution proposée par Habitude, qui correspond exactement à mon besoin, bravo et merci à vous !

Parfaite pour moi, à un détail prés : je souhaiterai que la "comparaison" entre les deux feuilles ne s'effectue que vis à vis des valeurs d'une seule colonne (C de préférence).

Une âme charitable pourrait elle venir à mon secours ? Merci d'avance,
Cordialement,

Jean-Baptiste.

 

[chatomon]

Re : comparer deux feuilles et supprimer les données communes

Bonjour,

Je reprends ce post car j'ai +/- le meme problème et suis nul en codage

J'ai télécharger les fichiers proposé mais ça ne fait pas ce que j'escompte.

En fait, j'ai 3 feuilles et je voudrais qu'une macro m'en crée une 4ème en m'indiquant ce qu'il me reste en stock sur la base des entrées MOINS les sorties PLUS les retours.

Quelqu'un peut il m'aider.

Merci d'avance

 

[Habitude]

Re : comparer deux feuilles et supprimer les données communes

Bonjour

Ceci devrait convenir

 

[chatomon]

Re : comparer deux feuilles et supprimer les données communes

GENIAL

Un grand Merci C'est exactement ce que je cherchais.

Comment avez vous fait cela ???
Je trouve rien dans Macro

 

[Habitude]

Re : comparer deux feuilles et supprimer les données communes

Au plaisir

Le code est dans la feuille solde

 

[chatomon]

Re : comparer deux feuilles et supprimer les données communes

Ok merci pour dire que je suis nul, j'ai du aller voir sur le forum comment faire pour voir les codes d'une feuille.

ALT+F11 est mon ami depuis

Un grand merci.

 

[chatomon]

Re : comparer deux feuilles et supprimer les données communes

Bonjour à tous,

Encore un souci, au bureau, on a excel 2003 (vous me direz qu'il serait bien de passer à plus récent ) et le code ne fonctionne pas du tout.

J'ai donc transformé le fichier en excel 97-2003 mais du coup j'ai un erreur dans le code.

N'y connaissant rien, pouvez vous m'aider ?

Merci