Discussion :

[jlduboc]

Bonjour à tous

Je souhaite filtrer un tableau à partir d'une valeur située dans une COMBO BOX Située sur u USER FORM

L'action de la macro bute sur

Range("LigNom").Select

Je pense que cette écriture correspond à une seule ligne, alors qu'il peut y avoir plusieurs lignes à filtrer.

Ci après l'écriture de ma macro

Nom de la COMBOBOX ou se trouve la valeur à filtrer = cmbFiltSecteur
Nom de la plage du tableau à filtrer = NomPlage
Nom de la plage de la colonne qui doit être filtrée = RechSect
Nom de l'entête de la colonne qui doit être filtrée = Secteur

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
Private Sub cmbFiltSecteur_Change()
 
Dim contacts As Object
Dim nom As String
Dim ligNom As Integer
Dim cellule As Object
 
Set contacts = Sheets("Contacts")
 
nom = Me.cmbFiltSecteur
ligNom = False
For Each cellule In Range("RechSect")
    If cellule = nom And ligNom = False Then
        ligNom = cellule.Row
    End If
Next cellule
 
 If ligNom <> False Then
 
Range("NomPlage").Select
    Selection.AutoFilter
    ActiveSheet.Range("NomPlage").AutoFilter Field:=1
 
  Range("LigNom").Select
 
        Unload Me
 
Else
    MsgBox ("Le nom" & nom & " est introuvable")
 
End If
 
End Sub

Cordialement

[antonysansh]

Bonjour jlduboc,

Premièrement pour aider les utilisateurs a te lire et leurs donner plus de chance de t'aider, utilise les Balise de code (#)

Apres voir lu rapidement ton code, il y a déjà quelque chose de pas logique :

Code :

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

1
2
3
Dim ligNom As Integer
ligNom = False
Range("LigNom").Select

Que la variable soit de type Integer ou Booléen, Range n'a aucune change de fonctionner.

[jlduboc]

Bonjour

Effectivement mon écriture n'était pas correcte
J'ai essayé autre chose

J'ai matérialisé des étapes avec des messages Box pour visualiser les parties qui fonctionnent.
et j'ai utlisé des feuilles de relai car je souhaite ultérieurement récupérer les lignes filtrées pour un 2ème niveau de filtre.

Mon écriture ne fonctionne pas au niveau du filtre

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
Private Sub cmbFiltSecteur_Change()
 
Sheets("Contacts").Select
 
'Récupère le texte à trier dans la COMBO BOX
 
Dim Sect As String
Sect = usfRecherche.cmbFiltSecteur.Value
 
'Copie le texte à trier dans la feuille "Critères" et dans la cellule A2
 
Sheets("Critères").Cells(2, 1).Value = Sect
 
'Affiche le texte saisi
 
MsgBox Sect
 
Dim i As String
 
'Compte le nombre de lignes non vides
 
i = Application.WorksheetFunction.CountA(Range("A:A"))
 
'Affiche le nombre de cellules non vides
 
MsgBox i
 
'Copie de la première ligne sur la feuille "Filtre"
 
Sheets("Contacts").Select
Range("A1").EntireRow.Select
Selection.Copy
Sheets("Filtre").Select
Range("A1").Select
ActiveSheet.Paste
 
'Filtre
 
With Worksheets("Contacts").Range("NomPlage").AdvancedFilter Action:=xlFilterCopy,
     CriteriaRange:=Sheets("Critères").Range("A2"),
     CopyToRange:=Sheets("Filtre").Cells, Unique:=False
 
End With
 
End Sub

Voila je n'ai pas beaucoup d'expérience en programmation VBA, cette application que je souhaite réaliser sera pour moi la dernière, je la transmettrai à mes successeurs.

Cordialement

[antonysansh]

Bonjour jlduboc,

Voilà un code qui devrait faire ton bonheur :

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
Private Sub cmbFiltSecteur_Change()
 
If usfRecherche.cmbFiltSecteur.Value = "" Then
    'rien
Else
    Dim Sect As String
    Sect = usfRecherche.cmbFiltSecteur.Value
 
    Sheets("Critères").Cells(2, 1).Value = Sect
 
    Dim i As String
    i = Application.WorksheetFunction.CountA(Range("A:A"))
 
    Sheets("Filtre").Select
    Range(Cells(2, 1), Cells(Application.Rows.Count, 2)).ClearContents
 
    Sheets("Contacts").Range("A1:B4").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critères").Range("A1:A2"), _
        CopyToRange:=Range("A1:B2")
End If
 
End Sub

Tu as juste à adapter à ta base Contacts car ici je ne prends que 2 colonnes.
La ligne CopyToRange:=Range("A1:B2") correspond a la ligne d'en-tête qui doit être présente sur la ligne 1 de l'onglet Filtre

[jlduboc]

Bonjour jlduboc,

Voilà un code qui devrait faire ton bonheur :

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
Private Sub cmbFiltSecteur_Change()
 
If usfRecherche.cmbFiltSecteur.Value = "" Then
    'rien
Else
    Dim Sect As String
    Sect = usfRecherche.cmbFiltSecteur.Value
 
    Sheets("Critères").Cells(2, 1).Value = Sect
 
    Dim i As String
    i = Application.WorksheetFunction.CountA(Range("A:A"))
 
    Sheets("Filtre").Select
    Range(Cells(2, 1), Cells(Application.Rows.Count, 2)).ClearContents
 
    Sheets("Contacts").Range("A1:B4").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Critères").Range("A1:A2"), _
        CopyToRange:=Range("A1:B2")
End If
 
End Sub

Tu as juste à adapter à ta base Contacts car ici je ne prends que 2 colonnes.
La ligne CopyToRange:=Range("A1:B2") correspond a la ligne d'en-tête qui doit être présente sur la ligne 1 de l'onglet Filtre

Bonjour

L'écriture proposée ne fait que copier la ligne de titre sur la feuille "Filtre" mais ne copie pas les lignes que je veux filtrer.

Cordialement

[antonysansh]

Bonjour jlduboc,

Tu dois adapter à ta base car là c'est juste un exemple d'utilisation.
Dans l'exemple je ne prends que 2 colonnes et suppose que ton ComboBox est une valeur de la première colonne si ce n'est pas le cas tu ne filtre effectivement sur rien.

Voilà un très bon tuto de ce site pour t'aiguiller : tutoriel advancedfilter

Tu peux aussi mettre ton fichier a disposition pour que j'adapte à ta base et commentant au mieux le code.