Probleme sur un filtre en macro [Résolu]

Signaler
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015
-
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015
-
Bonjour,

Je suis face à un nouveau problème, je voudrais filtrer via un commandButton sur un colonne a partir de la ligne A6 mais je ne parvient pas à le faire fonctionner, voici le code que j'ai écris (récuperer un autre fichier que je m'étais fais et qui était fonctionnel) :

Le CommandButton de l'usf :

Private Sub CommandButton1_Click()
'code du filtre à mettre en place
Dim lbVal As String
Dim arrCriteres()
If ListBox2.ListIndex = 1 Then Exit Sub
'Not sure that I need the next line. Listbox is a SingleSelect.
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
lbVal = ListBox2.List(i)
ReDim Preserve arrCriteres(i)
arrCriteres(i) = lbVal
End If
Next i
Range("A5:G6000").AutoFilter Field:=1, _
Criteria1:=arrCriteres, _
Operator:=xlFilterValues


Puis le code sur le bouton de mon ruban perso office via assistant ruban :

'Callback for filtre_inb onAction
Sub filtre_inb(control As IRibbonControl)

'Affiche les éléments la ListBox
Dim Cell As Range
Dim Unique As New Collection
Dim Valeur As Range
Dim i As Integer

'Récupère la derniere ligne non vide dans la colonne A
i = Range("A65536").End(xlUp).Row

On Error Resume Next
'boucle sur les cellules de la colonne A
For Each Cell In Range("A6:A" & i)
'Stocke les données dans une collection
'(La collection n'accepte que des données uniques et permet donc
' de filtrer facilement les doublons).
Unique.Add Cell, CStr(Cell)
Next Cell
On Error GoTo 0

'Boucle sur le contenu de la collection pour alimenter la ListBox
For Each Valeur In Unique
INB_filtre.ListBox2.AddItem Valeur
Next Valeur

INB_filtre.Show

End Sub


Pour les détails, l'entête de colonne se trouve en A5 les données commence en A6

Merci pour votre aide

4 réponses

Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015

Pour quelques détails sur ce qui ne vas pas, le filtre à l'aire de fonctionné mais :

Pour mes tests, je mets plusieurs valeurs dans ma colonne:

122
122
133
133
12
11

puis lorsque je lance mon filtre via mon ruban, la listbox est bien chargée, je sélectionne alors 122, il filtre les 122, je désélectionne 122 puis sélectionne 133, ça ne filtre pas, je désélectionne 133 et fais la même manip pour 12 et 11 et ça fonctionne...

J'avoue que la je sèche...

Votre aide est la bienvenue, comme toujours ;)
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
237
Bonjour,
Si par :
If ListBox2.ListIndex = 1 Then Exit Sub

tu veux dire que si rien n'a été sélectionné, alors quitter la sub, tu te trompes.
Si rien n'est sélectionné, La propriété Listindex est égale à -1 et non à 1.
elle est égale à 1 lorsque le 2ème article est sélectionné (en te rappelant que le 1er est d'index 0)

PS : en regardant ce que tu dis avoir dans la colonne :
La liste box en résultant contiendra donc (pas de doublons) :
122 -----------------------> index 0
133 -----------------------> index 1
12 -----------------------> index 2
11 -----------------------> index 3
Lorsque tu sélectionnes 133, le listindex est 1 ... et comme tu dis de quitter si = 1, ma foi ...
D'où la nécessité de faire ce que je t'ai dit en début de mon message.

Lorsque tu auras corrigé cela, je te parlerai d'autre chose.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015

Bonjour ucfoutu,

Merci de ta réponse, effectivement, l'erreur venait bien de là, j'ai du mal avec ça encore... mais je me soigne ;), voici le code corrigé :

Private Sub CommandButton1_Click()
'code du filtre à mettre en place
Dim lbVal As String
Dim arrCriteres()
If ListBox2.ListIndex = -1 Then Exit Sub
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
lbVal = ListBox2.List(i)
ReDim Preserve arrCriteres(i)
arrCriteres(i) = lbVal
End If
Next i
Range("$A$5:$CD$6000").AutoFilter Field:=1, _
Criteria1:=arrCriteres, _
Operator:=xlFilterValues
End Sub


Maintenant ça fonctionne, je vais pouvoir passer à la suite, mais ce qu'il me reste à faire risque d'être compliqué et je doute que vba fasse cela... je fais un nouveau poste.

Encore merci
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
237
Bien,

Parlons de deux autres petites choses :
1) remplace
i = Range("A65536").End(xlUp).Row

par
i = Range("A" & rows.count").End(xlUp).Row

cela te permettra de faire face si version acceptant beaucoup plus que 65536 lignes

2) parlons du peuplement sans doublons de ta listbox.
Pourquoi donc faire une collection, puis relire cette collection ?
VBA t'offre d'autres méthodes ===>>
a) en utilisant la fonction Countif :

Dim I As Long
I = Range("A" & Rows.Count).End(xlUp).Row
For j = 6 To I
If WorksheetFunction.CountIf(Range("A" & j + 1 & ":A" & I + 1), Range("A" & j).Value) = 0 Then
ListBox1.AddItem Range("A" & j).Value
End If
Next

ou
b) en utilisant les propriétés de la listbox de VBA :
 Dim c As Range, I As Long
I = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Range("A6:A" & I).Cells
On Error Resume Next
ListBox1.ListIndex = -1
ListBox1.Text = c.Value
If ListBox1.ListIndex = -1 Then ListBox1.AddItem c.Value
On Error GoTo 0
Next c

ou encore
c) en utilisant la méthode Find de VBA


 Dim plage As Range, I As Long
I = Range("A" & Rows.Count).End(xlUp).Row
For j = 6 To I
Set plage = Range("A" & j + 1 & ":A" & I + 1).Find(what:=Range("A" & j).Value, LookIn:=xlValues, lookat:=xlWhole)
If plage Is Nothing Then ListBox1.AddItem Range("A" & j).Value
Next

Voilà.
N'oublie pas de libérer cette discussion (tag RESOLU au niveau de ton premier message)

Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015

Je prend note de ces conseils, et vous en remercie beaucoup, je ferais la correction...

Merci pour vos apports et conseils

Je vous souhaite une excellente soirée

A bientôt