youpi457032
XLDnaute Occasionnel
Bonjour,
J'ai besoin d'aide.
Je souhaite filtrer une base de données avec des critères activés ou non par case à cocher (CheckBox)
Dans mon classeur ce filtre existe déjà avec des champs zone de texte… (Userform FILTRE)
et la macro qui le fait fonctionner marche très bien :
la voici [\CODE]
'Macro Faite par …..
Option Explicit
Private Sub Bt1_Click()
Dim aa, i&, a&, fin&, col&, n&, Y&, bb, v&, X$
L2.Clear: X = "": Feuil7.Label1 = ""
fin = Feuil7.Cells.Find("*", , xlValues, , 1, 2, 0).Row
If fin < 2 Then fin = 2
Feuil3.Range("A2:Q" & fin).ClearContents
X = "Filtre pour recherche : "
For n = 0 To L1.ListCount - 1
If L1.Selected(n) Then
X = X & L1.List(n, 0) & ", "
End If
Next n
With Feuil6
fin = .Range("A" & Rows.Count).End(3).Row
If fin < 2 Then fin = 2
aa = .Range("A2:Q" & fin)
For i = 1 To UBound(aa)
For n = 0 To L1.ListCount - 1
If L1.Selected(n) Then
For col = 5 To 17
If aa(i, col) = L1.List(n, 0) Then ' POUR MOI c'est La que ca coince
aa(i, UBound(aa, 2)) = "oui": Y = Y + 1: GoTo 1
End If
Next col
End If
Next n
1 Next i
End With
If Y = 0 Then Exit Sub
If Y = 1 Then
ReDim bb(1 To 1, 1 To UBound(aa, 2) - 1)
For i = 1 To UBound(aa)
If aa(i, UBound(aa, 2)) = "oui" Then
For a = 1 To UBound(bb, 2)
bb(1, a) = aa(i, a)
Next a
End If
Next i
Else
ReDim bb(1 To Y, 1 To UBound(aa, 2) - 1): Y = 1
For i = 1 To UBound(aa)
If aa(i, UBound(aa, 2)) = "oui" Then
For a = 1 To UBound(bb, 2)
bb(Y, a) = aa(i, a)
Next a
Y = Y + 1
End If
Next i
End If
With L2
L2.ColumnCount = 13
L2.List = bb
End With
With Feuil6
.Cells(2, 1).Resize(UBound(bb), UBound(bb, 2)) = bb
.Label1 = Mid(X, 1, Len(X) - 2): .Label1.Font.Bold = 1
.Select
End With
End Sub
Private Sub Bt2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
With L1
L1.List = Feuil2.Range("M2:M" & Feuil2.Range("M" & Rows.Count).End(3).Row).Value
L1.MultiSelect = 1
End With
End Sub
[/CODE]
j'ai essayé de fonctionner de la même manière avec des checkBox pour une autre utilité, mais forcément ça ne fonctionne pas puisque le résultat retourné n'est pas celui d'une Textbox.
Dans mon USERFORM FILTRE qui fonctionne, les valeurs des textBox sont comparées à celles d'une liste de référence (L1 de mon userform "Filtre"). Si les valeurs cibles de la feuille source sont identiques aux valeurs L1 sélectionnées, le Filtre fait son boulot, sinon rien...
Dans le cas que je soumets, vu qu'il s'agit non pas de Text box (qui renvoie une valeur strictement identique, à la valeur cible L1 recherchée), mais de CHECKBOX qui renvoie des résultats en "0" ou "-1", forcément çà ne fonctionne pas….
quelqu'un aurait il une idée pour corriger ma macro dans ce cas précis ?
Le code à corriger est en USERFORM "Filtre_manifestations" . Cet userfom travaille de concert avec les feuilles 6(manisfestations) et 7 (filtre manifestation)
Je joins le fichier a toute fin utile de compréhension...
Merci d'avance
J'ai besoin d'aide.
Je souhaite filtrer une base de données avec des critères activés ou non par case à cocher (CheckBox)
Dans mon classeur ce filtre existe déjà avec des champs zone de texte… (Userform FILTRE)
et la macro qui le fait fonctionner marche très bien :
la voici [\CODE]
'Macro Faite par …..
Option Explicit
Private Sub Bt1_Click()
Dim aa, i&, a&, fin&, col&, n&, Y&, bb, v&, X$
L2.Clear: X = "": Feuil7.Label1 = ""
fin = Feuil7.Cells.Find("*", , xlValues, , 1, 2, 0).Row
If fin < 2 Then fin = 2
Feuil3.Range("A2:Q" & fin).ClearContents
X = "Filtre pour recherche : "
For n = 0 To L1.ListCount - 1
If L1.Selected(n) Then
X = X & L1.List(n, 0) & ", "
End If
Next n
With Feuil6
fin = .Range("A" & Rows.Count).End(3).Row
If fin < 2 Then fin = 2
aa = .Range("A2:Q" & fin)
For i = 1 To UBound(aa)
For n = 0 To L1.ListCount - 1
If L1.Selected(n) Then
For col = 5 To 17
If aa(i, col) = L1.List(n, 0) Then ' POUR MOI c'est La que ca coince
aa(i, UBound(aa, 2)) = "oui": Y = Y + 1: GoTo 1
End If
Next col
End If
Next n
1 Next i
End With
If Y = 0 Then Exit Sub
If Y = 1 Then
ReDim bb(1 To 1, 1 To UBound(aa, 2) - 1)
For i = 1 To UBound(aa)
If aa(i, UBound(aa, 2)) = "oui" Then
For a = 1 To UBound(bb, 2)
bb(1, a) = aa(i, a)
Next a
End If
Next i
Else
ReDim bb(1 To Y, 1 To UBound(aa, 2) - 1): Y = 1
For i = 1 To UBound(aa)
If aa(i, UBound(aa, 2)) = "oui" Then
For a = 1 To UBound(bb, 2)
bb(Y, a) = aa(i, a)
Next a
Y = Y + 1
End If
Next i
End If
With L2
L2.ColumnCount = 13
L2.List = bb
End With
With Feuil6
.Cells(2, 1).Resize(UBound(bb), UBound(bb, 2)) = bb
.Label1 = Mid(X, 1, Len(X) - 2): .Label1.Font.Bold = 1
.Select
End With
End Sub
Private Sub Bt2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
With L1
L1.List = Feuil2.Range("M2:M" & Feuil2.Range("M" & Rows.Count).End(3).Row).Value
L1.MultiSelect = 1
End With
End Sub
[/CODE]
j'ai essayé de fonctionner de la même manière avec des checkBox pour une autre utilité, mais forcément ça ne fonctionne pas puisque le résultat retourné n'est pas celui d'une Textbox.
Dans mon USERFORM FILTRE qui fonctionne, les valeurs des textBox sont comparées à celles d'une liste de référence (L1 de mon userform "Filtre"). Si les valeurs cibles de la feuille source sont identiques aux valeurs L1 sélectionnées, le Filtre fait son boulot, sinon rien...
Dans le cas que je soumets, vu qu'il s'agit non pas de Text box (qui renvoie une valeur strictement identique, à la valeur cible L1 recherchée), mais de CHECKBOX qui renvoie des résultats en "0" ou "-1", forcément çà ne fonctionne pas….
quelqu'un aurait il une idée pour corriger ma macro dans ce cas précis ?
Le code à corriger est en USERFORM "Filtre_manifestations" . Cet userfom travaille de concert avec les feuilles 6(manisfestations) et 7 (filtre manifestation)
Je joins le fichier a toute fin utile de compréhension...
Merci d'avance
Dernière édition: