Filtration de Données via UserForm

Version imprimable

21/04/2023, 07h19
iliesman

1 pièce(s) jointe(s)

Filtration de Données via UserForm

Bonjour à tous, je me permets de poster ce message car mon programme ne retourne pas ce que j'attends.

Je m'explique : Je dispose d'un UserForm comprenant 14 CheckBox chacun associé à un Label.
Je dispose aussi d'un bouton commande "Filtrer". Le but de ce bouton est de filtrer ma feuille excel "Feuil1" en fonction des checkbox qui ont été coché.
Chaque checkbox correspond à une valeur dans une colonne précise. Ma feuille excel "Feuil1" comporte 32 entetes de A1 à AF1. Le but est de filtrer ma "Feuil1" et d'extraire de cette derniere les lignes ayant soit le checkbox1 soit le checkbox2... soit le checkbox14 soit les lignes qui ont toutes ces checkbox, dans la "Feuil2"

Malheureusement, lorsque je coche plusieurs checkbox, le programme retourne les lignes n'ayant qu'un critere correspondant juste à un checkbox..
Je pense que c'est un probleme de "Ou inclusif" mais je ne sais pas quoi modifier dans mon code...

Je vous remercie par avance et reste à votre disposition pour tout renseignement complémentaire.

Bien à vous

Salut,
Pour obtenir un filtrage avec une logique "Ou inclusif", il faut utiliser la méthode "AdvancedFilter" avec des critères multiples. Voici comment adapter votre code pour cela :

Code:

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
Private Sub Command_Button()
    Dim j As Integer
    Dim CheckBoxes() As MSForms.CheckBox
    Dim Critères() As Variant
    Dim PlageDonnées As Range
    Dim PlageRésultats As Range
    Dim FeuilleSource As Worksheet
    Dim FeuilleFiltree As Worksheet
 
    Set FeuilleSource = Sheets("Feuil1")
    Set FeuilleFiltree = Sheets("Feuil2")
    PlageFiltree.Cells.ClearContents
 
    'Création du tableau de critères
    j = 0
    For i = 1 To 14
        If Me.Controls("CheckBox" & i).Value = True Then
            ReDim Preserve CheckBoxes(j)
            Set CheckBoxes(j) = Me.Controls("CheckBox" & i)
            ReDim Preserve Critères(1 To j, 1 To 1)
            Critères(j, 1) = Me.Controls("CheckBox" & i).Caption & "=X"
            j = j + 1
        End If
    Next i
 
    'Filtrage des données avec une logique "Ou inclusif"
    Set PlageDonnées = FeuilleSource.Range("A1:AF" & FeuilleSource.Cells(Rows.Count, 1).End(xlUp).Row)
    Set PlageRésultats = FeuilleFiltree.Range("A1")
    PlageDonnées.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Critères, CopyToRange:=PlageRésultats
 
    'Suppression des filtres
    PlageDonnées.AutoFilter
 
    Unload Me
End Sub

J'ai supprimé la boucle "For" qui appliquait les filtres, car la méthode "AdvancedFilter" s'en charge automatiquement avec les critères fournis. J'ai également ajouté les lignes pour définir la plage de données et la plage de destination des résultats pour la méthode "AdvancedFilter". Enfin, j'ai ajouté la ligne pour supprimer les filtres après avoir copié les résultats dans la feuille "Feuil2". Non testé puisque tu n'as fourni qu'un fichier txt, j'espère qu'il n'y aura pas d'erreur.

21/04/2023, 11h57
iliesman

Merci beacuoup Franc, c'est super gentil de votre part, je vais essayer ceci de suite.
Merci encore,
Bien à vous,
Ilies
21/04/2023, 12h17
iliesman

Je pense qu'il y a une erreur d'indice au niveau de cette ligne : ReDim Preserve Critères(1 To j, 1 To 1)
En effet, à la ligne précédente, on initialise j=0, donc je pense que le "1 To j" pose un problème.
Bien à vous

Essaie comme ceci:

Code:

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
Private Sub CommandButton_Click()
    Dim i as Integer
    Dim j As Integer
    Dim CheckBoxes() As MSForms.CheckBox
    Dim Critères() As Variant
    Dim PlageDonnées As Range
    Dim PlageFiltree As Range
    Dim FeuilleSource As Worksheet
    Dim FeuilleFiltree As Worksheet
 
    Set FeuilleSource = Sheets("Feuil1")
    Set FeuilleFiltree = Sheets("Feuil2")
    Set PlageFiltree = FeuilleFiltree.Range("A1")
    PlageFiltree.Cells.ClearContents
 
    'Création du tableau de critères
    j = 0
    For i = 1 To 14
        If Me.Controls("CheckBox" & i).Value = True Then
            j = j + 1
            ReDim Preserve CheckBoxes(1 To j)
            Set CheckBoxes(j) = Me.Controls("CheckBox" & i)
            ReDim Preserve Critères(1 To j, 1 To 2)
            Critères(j, 1) = FeuilleSource.Range("A1:AF1").Cells(1, i).Value
            Critères(j, 2) = "X"
        End If
    Next i
 
    'Filtrage des données avec une logique "Ou inclusif"
    Set PlageDonnées = FeuilleSource.Range("A1:AF" & FeuilleSource.Cells(Rows.Count, 1).End(xlUp).Row)
    PlageDonnées.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Critères, CopyToRange:=PlageFiltree
 
    'Suppression des filtres
    PlageDonnées.AutoFilter
 
    Unload Me
End Sub

21/04/2023, 14h12
iliesman

Re-
Encore merci beaucoup pour votre aide.
Je viens de modifier le code, une erreur d'indice est présente à cette ligne : ReDim Preserve Critères(1 To j, 1 To 2)
Bien à vous
21/04/2023, 14h25
Franc

Mets j=1 au lieu de j=0, si ça marche pas, il faudra envoyer le fichier excel pour que je puisse tester.