code vba filtre auto multi critère

Version imprimable

Bonjour tout le monde,

j'ai besoin de faire un filtre multi critère, j'ai fait ce code, mais y a quelque chose qui bug .... :(

Voici mon code

Code:

1
2
3
4
5
6
7
8
9
10
11
Dim Criteres As Variant
 
    'compte le nombre de lignes et colonnes
        Range("A1").Select
        nblignes = Range("A1", Selection.End(xlDown)).Cells.Count
        nbColonnes = Range("A1", Selection.End(xlToRight)).Cells.Count
 
'Les critères de recherche
Criteres = Array("Approved", "Cancelled", "Closed", "Commitment made", "Completed", "Dispatched", "On-going", "Open", "Planned", "Positive Opinion", "Reclassified Downgrade", "Submitted", "No submission required", "Submitted to Agency")
 
ActiveSheet.Range("A1:" & nbColonnes & nblignes).AutoFilter Field:=11, Criteria1:=Criteres, Operator:=xlFilterValues

Si quelqu'un a une solution, je suis preneur
Merci par avance pour votre aide
Laurent

12/07/2018, 17h51
boisgontierjacques

Bonjour,

Code:

ActiveSheet.Range("A1").AutoFilter Field:=11, Criteria1:=Criteres, Operator:=xlFilterValues

Boisgontier
13/07/2018, 08h59
lolo69490

Super ça fonctionne :D

Merci à toi Boisgontier
13/07/2018, 09h31
lolo69490

désolé, je viens de me rendre compte qu'en fait j'ai besoin de ce code mais en sens inverse, en excluant les critères, voici le code que j'ai fait, mais ça bug ... bien évidemment ! :oops:

Code:

ActiveSheet.Range("A1").AutoFilter Field:=11, Criteria1:="<>" & Criteres, Operator:=xlFilterValues

Sais-tu d'où ça peut venir ?

Merci par avance pour ton aide
Laurent

2 pièce(s) jointe(s)

Bonjour,

En PJ, un exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub FiltreInverseListe()
  Set f1 = Sheets("feuil1")
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  liste = Array("paris", "lyon", "bordeaux")            ' Liste à ne pas sélectionner
  For Each c In liste: d(c) = "": Next c
  Set f2 = Sheets("feuil1")
  Set d2 = CreateObject("scripting.dictionary")     ' liste complémentaire
  d2.CompareMode = vbTextCompare
  For Each c In f2.Range("B2:B" & f2.[B65000].End(xlUp).Row)
   If Not d.exists(c.Value) Then d2(c.Value) = ""
  Next c
  ActiveSheet.Range("$A$1:$B$100").AutoFilter Field:=2, Criteria1:=d2.keys, Operator:=xlFilterValues
End Sub

Boisgontier

13/07/2018, 15h15
lolo69490

1 pièce(s) jointe(s)

désolé, mais je suis pas arrivé à modifier ton code pour le mettre à mon gout, enfin à l'appliquer à mon fichier. je te joins une copie de mon fichier.

Concernant la liste des filtres a appliquer il sont dans la feuille qui se créé automatiquement grâce a la macro.
En fait, le but de cette manœuvre est que je souhaite conservé que ces infos qui se trouve dans la colonne K et supprimer toutes les lignes qui n'ont pas ces infos en K.

Ne sachant pas comment faire, je pensais faire un filtre sans ces infos, et supprimer les lignes restantes pour effacer le filtre après afin de conserver que les infos nécessaires... j'espère que je suis assez clair ... donc si tu trouves une meilleure solution je suis preneur :?

Merci par avance pour tout ton temps consacré à m'aider

1 pièce(s) jointe(s)

Sélectionne ceux qui ne sont pas dans la liste:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub FiltreInverseListe()
  Set f1 = Sheets("raw data")
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  Liste = Array("Approved", "Cancelled", "Closed", "Commitment made", "Dispatched", "On-going", "Open", "Planned", "Positive Opinion", "Reclassified Downgrade", "No submission required", "Submitted to Agency")
  For Each c In Liste: d(c) = "": Next c
  Set f2 = Sheets("raw data")
  Set d2 = CreateObject("scripting.dictionary")     ' liste complémentaire
  d2.CompareMode = vbTextCompare
  For Each c In f2.Range("K2:K" & f2.[K65000].End(xlUp).Row)
   If Not d.exists(c.Value) Then d2(c.Value) = ""
  Next c
  If d2.Count > 0 Then
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=11, Criteria1:=d2.keys, Operator:=xlFilterValues
  Else
    MsgBox "Pas de Filtre!"
  End If
End Sub

Boisgontier

16/07/2018, 11h56
lolo69490

Merci à toi Boisgontier ...

ça fonctionne du feu de dieu !!!

merci pour ton aide