Macro filtre à partir d'une listbox

**scayhes** · 15/03/2013, 18h03

Bonjour à tous,

Afin de pouvoir filtrer une base de données sur plusieurs critères, j'ai créé dans un onglet une listbox dont les valeurs sélectionnées s'enregistrent dans un tableau qui est ensuite utilisé comme critère dans mon filtre. Mais j'ai le problème suivant :au lieu que le filtre soit de type "égal à" je voudrais qu'il soit de type "contient", ce que je n'arrive pas à coder. Si vous pouviez m'aider ce serait super !! Je sais que pour une chaine de caractères il suffit de rajouter "=*" & critère & "*", mais cela ne fonctionne pas dans mon cas.

Voici le code :

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
Dim tableau(1 To 20) As Variant 
 
nb = Sheets("ACCUEIL").ListBox1.ListCount 
 
j = 1 
For I = 0 To nb - 1 
 
If Sheets("ACCUEIL").ListBox1.Selected(I) Then 
tableau(j) = Sheets("ACCUEIL").ListBox1.List(I) 
j = j + 1 
End If 
Next I 
 
 
Sheets("DETAIL DES REFS").Rows("1:1").AutoFilter 
Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=13, Criteria1:=tableau, Operator:=xlFilterValues

Merci d'avance !!

**NVCfrm** · 16/03/2013, 03h56

bonsoir

tu pourras définir le critère au moment de l'affectation de l'élément du tableau:

Code :

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

tableau(j) = "*" & Sheets("ACCUEIL").ListBox1.List(I)& "*"

l'utilisation de la fonction AutoFilter avec un tableau de plusieurs éléments

je devrais réviser ... à voir peut-être. Cette méthode n'accepte que 2 critères à ma connaissance: Critéria1= "...", Operator:=xlOr, Critéria2=...
Par contre tu as AdvancedFilter.

je te propose cette modification de ton code:

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
Dim Tableau, i As Long, j As Long, r As Range, nb, crit As String, cl As Integer
 
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
 
    ReDim Tableau(1 To 1)
    j = 1
    For i = 0 To nb - 1
 
        If Sheets("ACCUEIL").ListBox1.Selected(i) Then
            ReDim Preserve Tableau(1 To j)
            Tableau(j) = "*" & Sheets("ACCUEIL").ListBox1.List(i) & "*"
            j = j + 1
        End If
    Next i
 
    Set r = Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000")
    crit = r.Cells(1, 1).Address
    r.Rows("1:" & UBound(Tableau) + 2).Insert shift:=xlDown
    Range(crit) = r.Cells(1, 1).Value
    Range(crit).Range(Cells(2, 1), Cells(UBound(Tableau) + 1, 1)) = Tableau
 
    r.AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range(crit).Range(Cells(1, 1), Cells(UBound(Tableau) + 2))
 
    Range(crit).Range(Cells(1, 1), Cells(UBound(Tableau) + 2, r.Columns.Count)).Delete xlUp
 
    With Application
        .ScreenUpdating = True
        .Calculation = cl
    End With

**scayhes** · 16/03/2013, 10h07

Salut NVCfrm et merci pour ta réponse.

Effectivement l'autofilter ne fonctionne que pour deux critères au plus, c'est pourquoi j'ai opté pour la solution du tableau qui permet de filtrer "sur plusieurs critères, en un critère".

J'ai essayé ce que tu me proposes et ça fonctionne ... pour un ou deux critères sélectionnés dans le tableau, pas plus !
Je crois que j'ai compris mon erreur : quand j'utilise un tableau il filtre les données "égales à" comme on le ferait à la main en sélectionnant les données, mais pour le coup du contient, seul un filtre personnalisé (en mode autofilter) est possible et donc là on est limité à deux critères.

Je vais essayer de m'inspirer de ce que tu me proposes en deuxième partie, mais j'ai un petit problème, que j'avais déjà eu précédemment, c'est que excel ne prend pas en compte ce code :

Code :

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

If Sheets("ACCUEIL").ListBox1.Selected(i) Then

c'est pour cela que j'avais privilégié la commande :

Code :

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

If Sheets("ACCUEIL").ListBox1.ListIndex <> 0 Then

Mais dans ce cas il ne fait pas une boucle et ne sélectionne que le premier item choisi ...

Je vais réfléchir à tout ça, je vous tiens au courant !

**graphikris** · 16/03/2013, 11h16

Bonjour,

Fais un code avec des inputbox dans lesquelles tu poses une question.
Ensuite tu passes par les filtres élaborés.

J'avais déjà posé une question de ce type vas voir ma discussion
Jette un oeil ici et vas voir le fichier joint le 20/01/13 à 17h46 par Fluch
http://www.developpez.net/forums/d12...ulti-criteres/

Si tu as un souci, joins un fichier.

**NVCfrm** · 16/03/2013, 22h10

Bonsoir,

La solution proposée en 2ème partie utilises la méthode AdvancedFilter. La zone de critère est dynamiquement crée en tenant compte du nombre de lignes de ton tableau. Après le filtre elle est détruite avant le rafraîchissement d'écran. je viens tester le code et ça fonctionne.

..., c'est que excel ne prend pas en compte ce code :

Code :

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

If Sheets("ACCUEIL").ListBox1.Selected(i) Then

il n'y a pas de raisons à cela si ta Listbox à bien la propriété MultiSelect à la valeur 1 ou 2.
tu peux vérifier avec ceci

Code :

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

1
2
3
4
5
    Dim i, n
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then n = n + 1
    Next
    MsgBox n & " choix sélectionnés."

**scayhes** · 18/03/2013, 15h09

Merci pour vos réponses.
graphikris : j'y avais pensé, mais je trouve que la listbox est plus adaptée aux utilisateurs de ce fichier, mais merci pour ta suggestion

NVCfrm merci pour ton aide, mais j'ai toujours un petit soucis :
je ne suis pas sûr de bien comprendre le code : lorsque je sélectionne plusieurs items de ma listbox, le premier critère se colle dans mon filtre élaboré autant de fois qu'il y a d'items sélectionnés, au lieu de coller les items sélectionnés un par un. (J'espère que tu comprendras)

Peut-être que je l'ai mal adapté dans mon code, car je ne vous ai fait partagé qu'une partie. En fait j'ai une listbox, puis 4 optionbuttons.
Voici mon code dans son intégralité :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub BoutonValiderSelection_Cliquer()
If Sheets("ACCUEIL").ListBox1.ListIndex = 0 Then
   Sheets("DETAIL DES REFS").AutoFilterMode = False
   Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=14, Criteria1:="="
    Else:
Dim Tableau(1 To 20) As Variant
 
nb = Sheets("ACCUEIL").ListBox1.ListCount
 
j = 1
For i = 0 To nb - 1
 
If Sheets("ACCUEIL").ListBox1.Selected(i) Then
   Tableau(j) = Sheets("ACCUEIL").ListBox1.List(i)
   j = j + 1
End If
Next i
 
 
    Sheets("DETAIL DES REFS").Rows("1:1").AutoFilter
    Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=14, Criteria1:="="
 
    Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=13, Criteria1:=Tableau, Operator:=xlFilterValues
  End If
 
If Sheets("ACCUEIL").OptionButton1.Value = True Then
 
 
    Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=31, Criteria1:="OUI"
 
    ActiveWorkbook.Worksheets("DETAIL DES REFS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DETAIL DES REFS").AutoFilter.Sort.SortFields.Add _
        Key:=Range("P1:P15000"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("DETAIL DES REFS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
ElseIf Sheets("ACCUEIL").OptionButton2.Value = True Then
Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=31, Criteria1:="NON"
 
    ActiveWorkbook.Worksheets("DETAIL DES REFS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DETAIL DES REFS").AutoFilter.Sort.SortFields.Add _
        Key:=Range("B1:B15000"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("DETAIL DES REFS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
ElseIf Sheets("ACCUEIL").OptionButton3.Value = True Then
Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=31
 
Else:   Sheets("DETAIL DES REFS").AutoFilterMode = False
        Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=13, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
            If Sheets("ACCUEIL").ListBox1.ListIndex <> 0 Then
            Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000").AutoFilter Field:=4, Criteria1:=Tableau, Operator:=xlFilterValues
 
            'C'est pour ce dernier bouton que je veux filtrer selon que les lignes qui contiennent ou pas le critère choisi dans la listbox            
 
            Sheets("DETAIL DES REFS").Select
            End If
 
End If
End Sub

J'avais essayé d'adapter ta proposition, mais cela sans succès ... Je débute en VBA et tout n'est pas encore toujours clair pour moi !
Merci par avance pour votre aide !

**NVCfrm** · 18/03/2013, 21h30

re,

Salut

en fait c'est un code qui était censé t'inspirer pour l'utiliser indépendamment dans une autre procédure ou dans ta condition. voici l'option indépendante:

Code :

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

1
2
3
...
If Sheets("ACCUEIL").ListBox1.ListIndex <> 0 Then Filtre_Table(Tableau()
....

Au sein de la fonction appelée dans le test If :

1 _ un tableau est dynamiquement redimensionné sur le nombre d'item sélectionnes de ta Listbox.
2 _ La dimension de ce tableau sera utilisé pour insérer une plage de critère au dessus de ta plage de données.
3 _ la méthode AdvancedFilter est ensuite exécutée.
4 _ la zone de filtre précédemment crée est alors détruite. et ta plage est restaurée à sa place comme si rien ne s'était passé.

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
35
36
37
38
39
40
41
Function Filtre_Table(Tableau as Object)
 
Dim liste , i As Long, j As Long, r As Range, nb, crit As String, cl As Integer
 
If TypeOf Tableau is ListBox then 
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
 
    nb  = Tableau.ListCount - 1
    ReDim Liste(1 To 1)
    j = 1
    For i = 0 To nb
 
        If Tableau.Selected(i) Then
            ReDim Preserve Liste(1 To j)
            Liste(j) = "*" & Tableau.List(i) & "*"
            j = j + 1
        End If
    Next i
 
    Set r = Sheets("DETAIL DES REFS").Range("$A$1:$AK$15000")
    crit = r.Cells(1, 1).Address
    r.Rows("1:" & UBound(Liste) + 2).Insert shift:=xlDown
    Range(crit) = r.Cells(1, 1).Value
    Range(crit).Range(Cells(2, 1), Cells(UBound(Liste) + 1, 1)) = liste
 
    r.AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range(crit).Range(Cells(1, 1), Cells(UBound(liste) + 2))
 
    Range(crit).Range(Cells(1, 1), Cells(UBound(Liste) + 2, r.Columns.Count)).Delete xlUp
 
    With Application
        .ScreenUpdating = True
        .Calculation = cl
    End With
 
end if      
 
End function

nb: la réponse a été rédigée ici directement. il pourrait y avoir des erreurs de saisie qui m'auraient échappés. Bon courage

**scayhes** · 19/03/2013, 14h58

Merci encore pour ta réponse. Dernier problème : j'ai une erreur à laquelle je n'ai jamais été confronté.
Pour la ligne de code suivante :

Code :

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

        If Sheets("ACCUEIL").ListBox1.ListIndex <> 0 Then Filtre_Table (Tableau())

j'ai l'erreur "type d'argument ByRef incompatible", et je ne vois pas où est l'erreur...
Un petit coup de main serait bienvenu

Je vous remercie d'avance.

Par ailleurs, j'ai un graphique croisé dynamique sur ma feuille "ACCUEIL", et j'aimerais bien que celui-ci évolue en fonction des critères sélectionnés dans ma listbox. Pour cela j'ai essayé d'enregistrer des macros pour voir à quoi pourrait ressembler le code et cela m'a l'air assez compliqué à mettre en place, même si au final il ne s'agirait que de filtres dans mon GCD.
Ma question est donc la suivante : y a t-il un moyen de mettre cela en place sans pour autant surcharger ma macro ? (peut-être en appelant une fonction ?)

Merci par avance !!

Bon finalement j'ai trouvé l'erreur j'ai défini tableau comme une Variant au lieu d'un Object pour être cohérent avec ce qui précède. Cela étant fait il y a encore des lignes qui ne fonctionnent pas à mon grand désarroi ! Je vous joindrai le fichier ce soir, le temps de l'anonymiser avant, ça sera peut-être plus facile ...

**NVCfrm** · 19/03/2013, 20h04

salut,
Peux tu donner les détails? Messages d'erreurs, la ou les lignes à problème .
il se pourrait que je ne consultes pas ton fichier. Je suis un peu "parano" avec les fichiers. Tu peux toujours le poster car beaucoup d'autres compétences pouvant résoudre tes problèmes sont plutôt à l'aise avec les fichiers exemples à télécharger.

**scayhes** · 21/03/2013, 10h11

Hello, me voilà de retour avec mes erreurs...

La première erreur intervient sur le code :

Code :

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

nb  = Tableau.ListCount - 1

il me dit "objet requis" pourtant mes items sont bien sélectionnés dans ma LB.

Il me met le même message d'erreur pour :

Code :

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

If Tableau.Selected(i) Then

et

Code :

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

liste(j) = "*" & Tableau.List(i) & "*"

Du coup il ne filtre sur rien du tout.
J'avais essayé de changé le nom de ma variable nb puisque déjà utilisé plus haut, mais ça n'a rien changé. Si tu as une astuce, je suis preneur ! Merci !

**NVCfrm** · 22/03/2013, 13h33

Bonjour scayhes,

L'argument doit être un objet défini sur listbox avant l'appel de la fonction.

Set Tableau =Listbox1

rien de plus.

tu peux essayer.

**scayhes** · 22/03/2013, 14h59

Hello,
j'ai bien essayé ce que tu me proposes, mais ça ne fonctionne pas plus. Je vais travailler là-dessus.

Sinon à tout hasard, j'ai un problème (bug ?) que je n'arrive pas à résoudre.
A l'ouverture du classeur ou à la réinitialisation de ma listbox par un autre bouton, celle-ci rétrécie. J'ai bien essayé de modifier les propriétés (format de controle, propriété mais pas moyen), mais le problème persiste. Aurais-tu une piste ?

Merci d'avance, car c'est très ennuyeux !

**NVCfrm** · 22/03/2013, 22h04

re,

une relecture du code me fait remarquer une gourde à la ligne qui teste l'objet.

Ce n'est pas le type du qui doit être testé, mais le nom du type. Fais ceci

Code :

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

If TypeName(Tableau) = "ListBox" Then

Remarque que le bloc If que j'ai mis dans le code est facultatif. Tu peux rendre l'exécution inconditionnelle ou changer la condition avec quelque chose qui te convient.
Pour le rétrécissement de la Listbox au chargement du classeur, je ne peux rien t'affirmer de précis. Plusieurs facteurs peuvent en être la cause.
Commence par supprimer la ListBox actuelle et crée un autre.
Ne lies pas la ListBox à une plage de feuille de calcul.
Tu pourras l'affecter une liste à l'exécution.
Ex:

Code :

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