Comparer deux colonnes puis supprimer les lignes en trop

Version imprimable

11/07/2011, 13h18
Theka

Comparer deux colonnes puis supprimer les lignes en trop

Bonjour à tous,

Voila j'ai deux feuilles dans un meme classeur, et je souhaite comparer admettons la colonne B de la premiere feuille avec la colonne B de la deuxieme feuille.

Dans ces colonnes se trouvent des valeurs.
admettons 1a 1a 1a 1a 2a 2a 2a 2a 3a 4a 5a 6a 8a 8a 9b ... etc ...

Je veux comparer ces deux colonnes, et vérifier que la valeur existe dans les deux feuilles.
Si ce n'ai pas le cas, je souhaite supprimer la ligne avec la valeur qui n'ai pas presente sur l'autre feuille., etc etc ..

C'est la feuille 3qui contient plus de ligne que la feuille 2. Donc toute les lignes de la feuille3 dont les valeur de la colonne B ne sont pas dans la colonne B de la feuille 2 doivent etre supprimé.

Voila. :D je ne sais pas si je me suis fais comprendre,

Merci d'avance pour toute vos idées et reflexion.

Essaye cela : ;)

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
Public Sub test()
 
Dim Lig2, Lig3 As Single
 
'Feuille 2
Set F2 = Sheets(2)
' Nb de ligne de la Colonne B de la Feuille 2
Lig2 = F2.Range("B65536").End(xlUp).Row
 
'Feuille 3
Set F3 = Sheets(3)
' Nb de ligne de la Colonne B de la Feuille 3 
Lig3 = F3.Range("B65536").End(xlUp).Row
 
'Pour chaque cellule de la colonne B de la Feuille 3
For Each cell3 In F3.Range(F3.Cells(1, 2), F3.Cells(Lig3, 2))
 
  ' recherche si le contenu de la cell3 est dans la colonne B de la feuille 2
    Set cc = F2.Range(F2.Cells(1, 2), F2.Cells(Lig2, 2)).Find(cell3.Value, , xlValues, xlWhole)
 
' Si aucune cellule trouvé dans la feuille 2, on supprime la ligne de la feuille 3
    If cc Is Nothing Then
        cell3.EntireRow.Delete
    End If
 
Next
End Sub

12/07/2011, 09h17
Theka

Bonjour Delphine,

Alors ça marche mais lorsque je clique une première fois, il ne m'enleve pas toute les lignes.

En faite dans mon test, un tableau de 1 a 4 sur la feuille 2 et 1 a 10 sur la feuille 3, le code va me supprimer donc la ligne 5 ainsi que toute les lignes impaires qui ne figure pas dans la feuille 2.

Et ensuite il faut que je relance pour supprimer les autres lignes.

Une idée ?

Essaye comma ca : :mrgreen:

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
30
Public Sub test()
 
Dim Lig2, Lig3, i As Single
 
'Feuille 2
Set F2 = Sheets(2)
Lig2 = F2.Range("B65536").End(xlUp).Row
 
'Feuille 3
Set F3 = Sheets(3)
Lig3 = F3.Range("B65536").End(xlUp).Row
 
 
i = 1
Do
    Set cell3 = F3.Cells(i, 2)
    Set cc = F2.Range(F2.Cells(1, 2), F2.Cells(Lig2, 2)).Find(cell3.Value, , xlValues, xlWhole)
 
    If i <= Lig3 Then
        If cc Is Nothing Then
            cell3.EntireRow.Delete
            Lig3 = Lig3 - 1
        Else
            i = i + 1
        End If
    End If
 
Loop While i <= Lig3
 
End Sub

12/07/2011, 10h54
Theka

:ccool:

Merci beaucoup Delphine, ça marche très bien.

EDIT : Est-il possible de copier toute les lignes en trop vers une nouvelle feuille a la place de les supprimer ?

Quand je modifie le code pour copier au lieu de supprimer, il n'execute pas la boucle. il s'arrette a la première valeur différente qu'il trouve.

Il faut enlever le i = i +1 du If si tu enleves le delete

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
30
31
32
33
34
Public Sub test()
 
Dim Lig2, Lig3, i As Single
 
'Feuille 2
Set F2 = Sheets(2)
Lig2 = F2.Range("B65536").End(xlUp).Row
 
'Feuille 3
Set F3 = Sheets(3)
Lig3 = F3.Range("B65536").End(xlUp).Row
 
'Feuille 4
Set F4 = Sheets(4)
Lig4 = 1
 
i = 1
Do
    Set cell3 = F3.Cells(i, 2)
    Set cc = F2.Range(F2.Cells(1, 2), F2.Cells(Lig2, 2)).Find(cell3.Value, , xlValues, xlWhole)
 
         If cc Is Nothing Then
            Lig4 = Lig4 + 1
            cell3.EntireRow.Copy
            F4.Cells(Lig4, 1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
         End If
 
    i = i + 1
 
Loop While i <= Lig3
 
End Sub

12/07/2011, 13h38
Theka

( C'est très gentil de ta part de prendre autant de temps pour m'aider )

J'ai malheuresement une erreur sur la ligne :

Code:

F4.Cells(Lig4, 1).Select