Comparer deux feuilles et supprimer les doublons

Version imprimable

Bonjour ,

Tout d’abord je tiens à préciser que Je ne suis pas un confirmé en programmation.
Voici mon problème que j’ai tenté de résoudre après des heures de recherches mais en vain car
Je ne retrouve pas en Feuille 2 les doublons qui devraient s’y trouver.

En effet j`ai une base de données (feuille1) et des nouvelles informations (feuille2).
Je souhaiterais comparer ce que j`ai dans ma nouvelle feuille par rapport à ce qui est déjà présent dans la base de données.
Ce qui est commun à la feuille 1 et 2, doit être supprimé dans la feuille 2.
A l’issue, le résultat de la feuille 2 doit venir se rajouter à la FEUILLE 1-
Merci pour l’aide que vous voudrez bien m’apporter.

voici mon fichier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub TriHorizontalSELECTIONAlain()
 
Dim PlgALAIN As Range
 Application.ScreenUpdating = False
With Worksheets("Feuil1")
    Set PlgALAIN = .Range("X3:AA782")
End With
TriHorizontalALAIN PlgALAIN
Set PlgALAIN = Nothing
End Sub
 Sub TriHorizontalALAIN(Rg As Range)
Dim R As Range
 For Each R In Rg.Rows
    R.Sort Key1:=R.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
Next
End Sub

Code:

1
2
3
Sub RANGEBasedonnees()
 Sheets("Feuil1").Range("A1:D998").Value = Sheets("Feuil1").Range("Q3:T1000").Value
End Sub

Code:

1
2
3
Sub RANGESELEC()
 Sheets("Feuil2").Range("A1:D780").Value = sheets("Feuil1").Range("X3:AA782").Value
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub compare()                                                                                      
 
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
LastLig1 = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Feuil2")
    LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = LastLig2 To 1 Step -1
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig1).Find(.Range("A" & i).Value, lookat:=xlWhole)
        If Not c Is Nothing Then
            Set c = Nothing
            .Rows(i).Delete
 
       LastLig2 = LastLig2 - 1
 
        End If
    Next i
    If LastLig2 > 0 Then .Range("A1:A" & LastLig2).Copy Sheets("Feuil1").Range("A" & LastLig1 + 1)
End With
End Sub

Par avance merci.

30/06/2011, 01h19
Philippe Tulliez
Bonsoir,
Dans ta procédure Compare, ce qui ne fonctionne pas c'est le fait que tu n'as pas recalculé la variable LastLig2 juste avant la copie vers Feuil1
Code:

1 2 LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row ' <<<< Ligne à rajouter If LastLig2 Then .Range("A1:A" & LastLig2).Copy Sheets("Feuil1").Range("A" & LastLig1 + 1)
30/06/2011, 02h30
trhibal

bonsoir,

merci de m'avoir répondu,
Cela ne fonctionne toujours pas en dépit de la modification opérée.

Cordialement.
30/06/2011, 07h24
galopin01

Bonjour,
Le fait de recalculer LastLig2 ne change rien puisque la ligne 16 recalcule cette variable en permanence.
D'ailleurs cette ligne (16) peut-être supprimée aussi. Elle ne sert à rien, en effet le résultat est le même : Cette macro fonctionne parfaitement !

Je l'ai testé sur une liste de prénoms féminin en Feuil1 et une liste de prénoms masculin en feuil2. Evidemment les prénoms mixtes sont des doublons !
Le résultat en Feuil1 est bien une liste de prénoms féminins et masculins sans doublons...

Ce qui ne marche pas est peut-être simplement dans l'énoncé de ton problème :

Citation:

Je ne retrouve pas en Feuille 2 les doublons qui devraient s’y trouver.

Normal puisque tu les supprimes ! :mouarf:

Cette macro rajoute uniquement les nouveaux enregistrements dans la Feuille1.

Rappel : "ça ne fonctionne pas" n'est pas une réponse : il faut préciser ce qui ne marche pas ! En quoi le résultat n'est-il pas conforme à ton attente ?

A+
30/06/2011, 08h11
Philippe Tulliez

Bonjour,

Citation:

Envoyé par trhibal

bonsoir,
merci de m'avoir répondu,
Cela ne fonctionne toujours pas en dépit de la modification opérée.
Cordialement.

Effectivement, j'ai fais ce test assez tard dans la soirée et après avoir envoyé un message disant que tout était bon pour moi, j'ai constaté des choses curieuses et après avoir changé
cette ligne tout fonctionnait mais j'ai dû m'emmêler les pinceaux.
Je confirme donc que la procédure compare fonctionnait parfaitement d'après ce que ton explication. Les valeurs de la feuille2 colonne 1 se trouvant également dans la feuil1 colonne 1, sont bien détruit de la feuil2 et les éléments restant copiés dans la feuil1.
30/06/2011, 13h57
trhibal

1 pièce(s) jointe(s)

@ galopin01
Bonjour,

En effet l'énoncé de mon problème n'était pas clair.
A 02h45 j'avais du sable dans les yeux..Désolé

En acceptant mon fichier, je pense que ça sera plus clair.

Voici mon problème :

FEUILLE -1-
-1 -Je saisis des données numériques dans ma plage :
("AE3:AE19"- sélection-saisie)

-2 Ces données sont triées de manière croissante et horizontalement en FEUILLE -1- "X3:AA782"

-3 -Ces mêmes données (FEUILLE -1-"x3:aa782")
sont envoyées en FEUILLE -2- "A1:D780"

-4 -j'actionne SUB COMPARE et l'élimination des doublons ne se fait pas ?

En revanche et à titre d'essai :

Si Je saisi manuellement mes données numériques dans la plage : FEUILLE -1- "X3:AA782" et que ces données ne figurent pas dans ma base de données sises "FEUILLE -1- A1-D1000" - L'élimination des doublons s'effectue correctement.

En espérant avoir été plus clair.
Merci par avance pour l'aide que vous pourrez m'apporter.
Cordialement

@ corona
Bonsoir,

Non le fichier ne fonctionne pas parfaitement.
J'en explique plus haut les raisons.
Sinon je ne viendrais pas quémander de l'aide.

Cordialement.
01/07/2011, 00h02
mercatog

Dans quelle feuille tu veux éliminer les doublons?
Dis toi que tes explications ne sont pas claire.

PS:

Code:

'LastLig2 = LastLig2 - 1 'ligne supprimée puisque superflue...

Tu peux m'expliquer cette remarque?
Tu peux m'expliquer la différence entre laisser cette ligne et la supprimer?
01/07/2011, 00h13
trhibal

Bonsoir,

Ce n'est pas moi qui préconise la suppression de cette ligne mais Corona.
J'ai lu et relu mes DERNIERES explications avec le dernier fichier à l'appui
et je pense qu'elles ne peuvent pas être plus claires.
Je souhaiterais éliminer ces doublons ........ dans ma feuille 2.

:no:

EDIT
A la place de tous les codes, re teste celui ci (en ayant au préalable la gentillesse de supprimer les grossièretés de ton post)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub UltimeTest()                                                                                      'dont l'auteur est MERCATOG avec mes remerciements !!
Dim LastLig As Long, j As Integer, i As Integer
Dim c As Range
 
Application.ScreenUpdating = False
LastLig = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Feuil2")
    .UsedRange.Clear
    .Range("A1:D780").Value = Sheets("Feuil1").Range("X3:AA782").Value
    .Range("A1:D780").Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
    For i = 780 To 1 Step -1
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig).Find(.Range("A" & i).Value, lookat:=xlWhole)
        If Not c Is Nothing Then
            Set c = Nothing
            .Rows(i).Delete
            j = j + 1
        End If
    Next i
    If j < 780 Then .Range("A1:D" & 780 - j).Copy Sheets("Feuil1").Range("A" & LastLig + 1)
End With
End Sub

PS: Tu comprends que les lignes supprimées dans Feuil2 sont celles où en colonne A on a une donnée qui existe aussi en colonne A de Feuil1.

01/07/2011, 01h01
trhibal

RE?

Etant de loin quelqu'un de méchant, je retire illico presto ce que tu considères comme des grossièretés. Si elles t'ont troublées accepte mes excuses. Ce n'était pas du tout et sincèrement mon intention.

Maintenant je me re centre sur mon problème car je ne suis pas du genre à abandonner facilement.

Je te ferai part, si tu le veux bien, du résultat après avoir effectué les correctifs proposés.

Merci.

re,

Je viens de tester cette "ultime macro" et hélas elle ne m'enlève pas les doublons en FEUILLE -2-

Il n'en demeure pas moins que Je vous suis (toi et ceux qui se sont penchés sur ce problème) sincèrement reconnaissant pour m'avoir consacré bénévolement de votre temps.
Aussi je n'ose plus dire quoique ce soit sur ce problème.
Et s'agissant de ceux à venir, je m'efforcerai d'être plus clair sur leurs énoncés.

Cordialement

Pour le tri horizontal, après test, il y avait un problème
ci joint rectificatif

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub UltimeTest()                                                                                      'dont l'auteur est MERCATOG avec mes remerciements !!
Dim LastLig As Long, j As Integer, i As Integer
Dim c As Range
 
Application.ScreenUpdating = False
LastLig = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Feuil2")
    .UsedRange.Clear
    .Range("A1:D780").Value = Sheets("Feuil1").Range("X3:AA782").Value
    TriH .Range("A1:D780")
    For i = 780 To 1 Step -1
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig).Find(.Range("A" & i).Value, lookat:=xlWhole)
        If Not c Is Nothing Then
            Set c = Nothing
            .Rows(i).Delete
            j = j + 1
        End If
    Next i
    If j < 780 Then .Range("A1:D" & 780 - j).Copy Sheets("Feuil1").Range("A" & LastLig + 1)
End With
End Sub
 
Private Sub TriH(Rng As Range)
Dim R As Range
 
For Each R In Rng.Rows
    R.Sort Key1:=R.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
Next R
End Sub

01/07/2011, 01h36
trhibal

Comparer deux feuilles et supprimer les doublons

re,

Je viens de tester cette "ultime macro" et hélas elle ne m'enlève pas les doublons en FEUILLE -2-

Il n'en demeure pas moins que Je vous suis (toi et ceux qui se sont penchés sur ce problème) sincèrement reconnaissant pour m'avoir consacré bénévolement de votre temps.
Aussi je n'ose plus dire quoique ce soit sur ce problème.
Et s'agissant de ceux à venir, je m'efforcerai d'être plus clair sur leurs énoncés.

Cordialement

Comparer deux feuilles et supprimer les doublons

Hourra !!!!!!

03h10 !

ça marche.

Je vous dois une explication.

La macro (SUB COMPARE) pour l'élimination des doublons en FEUILLE 2 ne traitait pas les données correctement car dans ma plage FEUILLE -1- "X3:AA780" j'avais saisi les données comme suit avant de les expédier en FEUILLE 2-
Code:

1 2 3 4 =$ae3$ =$ae4$ =$ae5$ =$ae6$ =$ae3$ =$ae4$ =$ae5$ =$ae7$ =$ae3$ =$ae4$ =$ae5$ =$ae8$ =$ae3$ =$ae4$ =$ae5$ =$ae9$ etc...
etc...
Code:

1 2 3 4 5 6 Or, pour une raison que je ne suis pas en mesure d'expliquer, il fallait saisir : =feuil1!$ae3$ =feuil1!$ae4$ =feuil1!$ae5$ =feuil1!$ae6$ =feuil1!$ae3$ =feuil1!$ae4$ =feuil1!$ae5$ =feuil1!$ae7$ =feuil1!$ae3$ =feuil1!$ae4$ =feuil1!$ae5$ =feuil1!$ae8$ =feuil1!$ae3$ =feuil1!$ae4$ =feuil1!$ae5$ =feuil1!$ae9$ etc jusqu'à "X3;aa782
Donc cette macro (SUB COMPARE) était au top !

Un grand merci à MERCATOG notamment et tous ceux qui se sont investis.

:ccool: