Discussion :

[l.flipper]

Bonjour,
Je voudrais supprimer d'une feuille toutes les lignes qui ne correspondent pas à une liste de valeurs.
Ex
Feuille 1 colonne A
D
B
C
B
A

Feuille 2 colonne A
B
C
Je ne veux garder dans la feuille 1 que les lignes contenant B et C. Le nombre de lignes dans la feuille 2 peut changer.
Si je teste ligne par ligne c'est beaucoup trop long, et je ne parviens pas à mettre en place un filtre qui ne contiendrait pas les valeurs afin de pouvoir supprimer toutes les lignes. Je sais exclure une valeur, même plusieurs avec un nombre fixe de critères, mais pas avec un nombre variable.
Comment faire ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1").AutoFilter Field:=2, Criteria1:="<>" & sheets("feuille 2").cells(1,1)

Merci

[Phil Free]

Bonjour,


Cela pourrait être un truc comme cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="<>" & sheets("feuille 2").cells(1,1).value , Operator:=xlAnd, Criteria2:="<>" & sheets("feuille 2").cells(2,1).value

Mais ! j'imagine que le nombre de critères pourrait être supérieur a 2 non ?
du coup la ligne du dessus ne fonctionne plus !

au delà de 2 critères il te faudra passer par une variable tableau. cela donnerait un truc du genre :

Attention pour le code qui suit je suppose que tes données en feuille 1 on une entête !
Le principe et afin de limiter l'utilisation des boucles, le filtre excel etant beaucoup plus rapide, on vas d'abord filtrer pour regrouper dans une variable les données à conserver
que l'on cachera puis on effacera ce qui reste.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim MesCriteres() As Variant, NbLigneDeCriteres As Long, i As Long
Dim Maplage As Range, DerniereLigne As Long, PlageaConserver As Range
 
 
DerniereLigne = Worksheets("Feuil1").Range("A" & Worksheets("Feuil1").Columns("A").Rows.Count).End(xlUp).Row 'position de la derniere valeur de la colonne A de la feuille 1
Set Maplage = Worksheets("Feuil1").Range("A1:A" & DerniereLigne) 'plage à netoyer 'on définit la plage en Feuille 1
 
NbLigneDeCriteres = Worksheets("Feuil2").Range("A" & Worksheets("Feuil2").Columns("A").Rows.Count).End(xlUp).Row 'nombre de critère en feuille 2
ReDim MesCriteres(NbLigneDeCriteres) ' on redimensionne la variable tableau en fonction du nombre de critere
 
For i = 1 To NbLigneDeCriteres 
   MesCriteres(i) = Worksheets("Feuil2").Range("A" & i).Value 'on remplis le tableau de criteres
Next
 
Worksheets("Feuil1").Range("A1").AutoFilter Field:=1, Criteria1:=MesCriteres(), Operator:=xlFilterValues 'on applique le filtre
 
    'on à maintenant les données à conserver en feuille 1
    Set PlageaConserver = Maplage.SpecialCells(xlCellTypeVisible) 'on les met de coté dans un objet range
    Worksheets("Feuil1").ShowAllData 'on enlève le filtre
    PlageaConserver.EntireRow.Hidden = True 'on cache les données à conserver
    Maplage.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'on supprime ce qui reste visible
    Maplage.EntireRow.Hidden = False 'on affiche les données conservées

je n'ai pas testé ! et ce bout de code fonctionnera qu'après adaptation à la structure de ton fichier donc vérifie les noms de feuille etc, mais l'idée est la.

A+

[l.flipper]

Bonjour, merci pour ta réponse.
Le filtre ne fonctionne pas, il ne me reste plus aucune valeur.
La bonne colonne se sélectionne (on voit qu'un filtre est appliqué) mais aucune valeur n'est cochée et aucune donnée n'est visible.
J'ai bien les bonnes données dans le tableau MesCriteres.

[Phil Free]

Ce serait bien que tu nous montres comment tu as adapté le code que je t'ai donné ! par ce que la...

[l.flipper]

Ce serait bien que tu nous montres comment tu as adapté le code que je t'ai donné ! par ce que la...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim MesCriteres() As Variant, NbLigneDeCriteres As Long, i As Long
Dim Maplage As Range, DerniereLigne As Long, PlageaConserver As Range
 
 
DerniereLigne = Worksheets("Table").Range("A" & Worksheets("Table").Columns("A").Rows.Count).End(xlUp).Row 'position de la derniere valeur de la colonne A de la feuille 1
Set Maplage = Worksheets("Table").Range("A1:L" & DerniereLigne) 'plage à nettoyer 'on définit la plage en Feuille 1
 
NbLigneDeCriteres = Worksheets("Liste Codes-Lot").Range("A" & Worksheets("Liste Codes-Lot").Columns("A").Rows.Count).End(xlUp).Row 'nombre de critère en liste codes-lot
ReDim MesCriteres(NbLigneDeCriteres - 1) ' on redimensionne la variable tableau en fonction du nombre de critere
 
For i = 0 To NbLigneDeCriteres - 1
   MesCriteres(i) = Worksheets("Liste Codes-Lot").Range("A" & i + 1).Value 'on remplit le tableau de criteres
Next
 
 
Worksheets("Table").Range("a1").AutoFilter Field:=2, Criteria1:=MesCriteres(), Operator:=xlFilterValues 'on applique le filtre
 
 
    'on à maintenant les données à conserver en feuille 1
    Set PlageaConserver = Maplage.SpecialCells(xlCellTypeVisible) 'on les met de coté dans un objet range
    Worksheets("Table").ShowAllData 'on enlève le filtre
    PlageaConserver.EntireRow.Hidden = True 'on cache les données à conserver
    Maplage.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'on supprime ce qui reste visible
    Maplage.EntireRow.Hidden = False 'on affiche les données conservées

[MarcelG]

Bonjour flipper,

Si j'ai bien compris, tu cherches, du moins dans un premier temps, à supprimer les lignes des cellules dont la valeur n'est pas trouvée dans la 2nde feuille.
Dans ces conditions, tu peux très bien utiliser la méthode Find, non?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Public Sub suppr_lignes()
 
Dim derlign1 As Long, i As Long
Dim derlign2 As Long
Dim laplage As Range, t As Range
 
Application.ScreenUpdating = False
 
With Worksheets("WKS2")
        derlign2 = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set laplage = .Range("A1:A" & derlign2)
End With
 
With Worksheets("WKS1")
        derlign1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = derlign1 To 1 Step -1
                With .Cells(i, 1)
                        Set t = laplage.Find(.Value, LookIn:=xlValues, lookat:=xlPart)
                        If t Is Nothing Then 
                            .EntireRow.Delete
                        Else
                             Set t = Nothing
                        End If                 
                End With
        Next i
End With
 
Set laplage = Nothing
 
Application.ScreenUpdating = True
 
End Sub

[Phil Free]

ah !!!

ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("Table").Range("a1").AutoFilter Field:=2, Criteria1:=MesCriteres(), Operator:=xlFilterValues 'on applique le filtre

field:= 2 veut dire filtre appliqué sur 2ieme colonne de Worksheets("Table").Range("a1") !!! elle est ou la 2ieme colonne dans la plage Range("a1") ?

dans ce cas tu dois utiliser la variable maplage qui représente ton tableau filtré. donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Maplage.AutoFilter Field:=2, Criteria1:=MesCriteres(), Operator:=xlFilterValues 'on applique le filtre

[Philippe Tulliez]

Bonjour,
Si tu veux filtrer une liste de données suivant plusieurs critères et rendre ceux ci variables avec en plus la possibilité d'exporter ces données et sans devoir toucher au code VBA, une fois celui-ci mis en place, je ne peux que te conseiller de t'intéresser au filtre avancé d'excel en VBA (méthode AdvancedFilter). En gros si tu t'organises bien, c'est une ligne de code et au maximum moins de 10.

A lire éventuellement Les filtres avancés ou élaborés dans Excel

[l.flipper]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim MesCriteres() As Variant, NbLigneDeCriteres As Long, i As Long
Dim Maplage As Range, DerniereLigne As Long, PlageaConserver As Range
 
 
DerniereLigne = Worksheets("Table").Range("A" & Worksheets("Table").Columns("A").Rows.Count).End(xlUp).Row 'position de la derniere valeur de la colonne A de la feuille 1
Set Maplage = Worksheets("Table").Range("A1:L" & DerniereLigne) 'plage à nettoyer 'on définit la plage en Feuille 1
 
NbLigneDeCriteres = Worksheets("Liste Codes-Lot").Range("A" & Worksheets("Liste Codes-Lot").Columns("A").Rows.Count).End(xlUp).Row 'nombre de critère en liste codes-lot
ReDim MesCriteres(NbLigneDeCriteres - 1) ' on redimensionne la variable tableau en fonction du nombre de critere
 
For i = 0 To NbLigneDeCriteres - 1
   MesCriteres(i) = Worksheets("Liste Codes-Lot").Range("A" & i + 1).Value 'on remplit le tableau de criteres
Next
 
 
Maplage.AutoFilter Field:=2, Criteria1:=MesCriteres(), Operator:=xlFilterValues 'on applique le filtre
 
 
    'on à maintenant les données à conserver en feuille 1
    Set PlageaConserver = Maplage.SpecialCells(xlCellTypeVisible) 'on les met de coté dans un objet range
    Worksheets("Table").ShowAllData 'on enlève le filtre
    PlageaConserver.EntireRow.Hidden = True 'on cache les données à conserver
    Maplage.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'on supprime ce qui reste visible
    Maplage.EntireRow.Hidden = False 'on affiche les données conservées

Toujours pas de données filtrées

[l.flipper]

Bonjour flipper,

Si j'ai bien compris, tu cherches, du moins dans un premier temps, à supprimer les lignes des cellules dont la valeur n'est pas trouvée dans la 2nde feuille.
Dans ces conditions, tu peux très bien utiliser la méthode Find, non?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Public Sub suppr_lignes()
 
Dim derlign1 As Long, i As Long
Dim derlign2 As Long
Dim laplage As Range, t As Range
 
Application.ScreenUpdating = False
 
With Worksheets("WKS2")
        derlign2 = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set laplage = .Range("A1:A" & derlign2)
End With
 
With Worksheets("WKS1")
        derlign1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = derlign1 To 1 Step -1
                With .Cells(i, 1)
                        Set t = laplage.Find(.Value, LookIn:=xlValues, lookat:=xlPart)
                        If t Is Nothing Then 
                            .EntireRow.Delete
                        Else
                             Set t = Nothing
                        End If                 
                End With
        Next i
End With
 
Set laplage = Nothing
 
Application.ScreenUpdating = True
 
End Sub

Boucler sur toutes les lignes de mon tableau est beaucoup trop long, j'étais partie sur ce genre de code au départ.