Discussion :

[hozce]

Bonjour à tous!

Tout d'abord, je suis nouveau sur le site, j'espère juste ne pas avoir créé une nouvelle discussion dans un mauvais emplacement...

Je débute en VBA et je suis bloqué dans ma recherche.

J'ai un classeur avec différents onglets (en PJ) :
- Premier onglet : Tableau de données fournisseurs (48 mais éventuellement modifiable dans les années à venir...)
- Second onglet : Matrice métier

J'aimerai avoir une liste multi-choix des différents métiers, qui permettrait de filtrer les fournisseurs correspondants aux métiers sélectionnés.
Par exemple en filtrant par métier 2, obtenir la liste des entreprises 1, 16, 17, et 34.
Ou encore en filtrant par métier 2 et 5, obtenir la liste des entreprises 1, 11, 16, 17, 34 et 43.

Voilà! J'ai pu trouver des astuces pour filtrer en fonction des données présentes dans le tableau de l'onglet 1, mais dans le cas recherché : filtrer en fonction d'une matrice annexe, je ne sais vraiment pas comment procéder... Est-ce que c'est faisable? Et comment?

Je suis preneur de toutes vos idées et conseils !

Merci à tous!

[PMO2017]

Bonjour,

Une piste en VBA.
Il faudra relier votre contrôle de formulaire (Excel.ListBox) à une macro



Copiez le code suivant dans un module Standard

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
Sub ListBox2Filtre()
'/// La 1ère cellule du tableau Excel ///
Const FIRST_CELL_CAPABILITE As String = "B18"   'à adapter
'///////////////////////////////////////
Dim LB As Excel.ListBox   'Contrôle de formulaire (ce n'est pas un ActiveX)
Dim Coll As New Collection
Dim R As Range
Dim LesMetiers$
Dim Tbl As Variant
Dim var As Variant
Dim k&
Dim i&
Dim j&
Dim T()
'--- La ListBox qui a appelé ---
Set LB = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
'--- Les métiers qui ont été sélectionnés sont stockés dans une variable String ---
For i& = 1 To LB.ListCount
  If LB.Selected(i&) Then LesMetiers$ = LesMetiers$ & LB.List(i&) & "µ"
Next i&
 
'--- Definition de la 1ère cellule du tableau Excel (Capabilité) ---
Set R = Range(FIRST_CELL_CAPABILITE)
'--- Efface le filtre (par défaut) ---
R.AutoFilter
 
'--- Si aucun métier n'a été sélectionné, on sort ---
If LesMetiers$ = "" Then Exit Sub
 
'--- Split de la chaîne pour obtenir un tableau des métiers ---
Tbl = Split(LesMetiers$, "µ")
 
'###
'--- On monte toutes les données de la feuille "Métiers" dans un Variant ---
var = Sheets("Métiers").[a1].CurrentRegion
 
For k& = 0 To UBound(Tbl) - 1       'boucle sur les métiers
  For j& = 1 To UBound(var, 2)      'boucle sur les colonnes (concerne la feuille "Métiers")
    If var(1, j&) = Tbl(k&) Then    'si on trouve une correspondance métier ...
      For i& = 1 To UBound(var, 1)  '... on boucle sur les lignes (concerne la feuille "Métiers") ...
        If UCase(var(i&, j&)) = "X" Then  '... si on y touve un X ...
          On Error Resume Next  '\\\Pour éviter les doublons
          Coll.Add CStr(var(i&, 2)), CStr(var(i&, 2)) '... on l'ajoute à la collection.
          On Error GoTo 0       '\\\Pour éviter les doublons (suite)
        End If
      Next i&
    End If
  Next j&
Next k&
 
'--- Si aucun élément n'a été ajouté à la collection, on sort ---
If Coll.Count = 0 Then Exit Sub
 
'--- Transfert des éléments de la collection dans un tableau ---
ReDim T(1 To Coll.Count)
For i& = 1 To Coll.Count
  T(i&) = Coll(i&)
Next i&
'--- Active le filtre en fonction des éléments du tableau (T) ---
R.CurrentRegion.AutoFilter Field:=2, Criteria1:=T, Operator:=xlFilterValues
End Sub

[camarchepas]

Bonjour, ma contribution avec un petit userform, je n'arrive pas à joindre le fichier ca marche pas...S'il vous interesse je trouverai un moyen de vous le faire parvenir. Les éléments trouvés sont dans une feuille différente des autres donc les données peuvent être manipulées et effacées sans risque de toucher aux bases de données. L'userform reste ouvert tant que vous ne l'avez pas fermé et la liste se met à jour automatiquement après chaque selection in.Cordialement.

Le code n'est pas trop complexe donc il sera aisé de le modifier si besoin

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
Private Sub CommandButton1_Click()
    With Feuil1
        .Cells.Delete
        Feuil5.[a1:m1].Copy .[a1:m1]
        .[a1:m1].Borders.LineStyle = xlContinuous
    End With
 
 
    Dim a, i, j
    a = Feuil3.UsedRange
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            For j = 2 To UBound(a)
                If a(j, i + 5) <> "" Then
                    With Feuil5
                        Set trouve = .[b:b].Find(a(j, 2), LookIn:=xlValues, lookat:=xlWhole)
                        If Not trouve Is Nothing Then
                            .Range(.Cells(trouve.Row, 1), .Cells(trouve.Row, 13)).Copy Feuil1.[a65000].End(xlUp).Offset(1, 0)
                        End If
                    End With
                End If
            Next
        End If
    Next
With Feuil1.UsedRange
.Columns.AutoFit
.Rows.AutoFit
End With
End Sub

[hozce]

Bonjour à tous !

Ca s'approche beaucoup de ce que je voulais, encore merci PMO2017 !
Merci à toi aussi Camarchepas, j'aimerais bien le fichier afin d'y jeter un coup d'œil aussi. Comment faire?

[camarchepas]

Ah bah sa marche maintenant...Pour rappel, dans l'userform vous selectionnez vos métier et vous cliquez sur commander

[hozce]

J'aimerai pousser la macro un peu plus loin!

Je voudrai combiner plusieurs filtres. Après avoir filtré par métiers (Via la matrice externe métiers), je souhaiterai ajouter des filtres en fonction des éléments du tableau.

Voir PJ :

Par exemple lorsque je filtre par métier 2, j'ai 4 entreprises avec 4 risques différents, et j'aimerai pouvoir filtrer uniquement les risques A1 de ce métier.
Pour ça j'étais parti sur une liste déroulante avec une formule index pour le filtre mais ca veut pas combiner avec le précédent filtre proposé par PMO2017 ...

Help !