XL 2019 filtre avancé VBA

Y

youpi457032

XLDnaute Occasionnel
Bonjour,
je possède une macro pour filtrer et sous filtrer sur plusieurs colonnes
J'aimerai adapter mon code pour que le premier critère ne filtre par sur une seule colonne mais plusieurs colonnes qui regroupent le même type de données.
Exemple dans les colonnes 13 à 17 j'ai des données identiques. J'aimerai que le filtre fasse le travail sur l'ensemble des colonnes 13 à 17 et non uniquement la colonne 13.
Mon dchoisis1 doit faire le travail sur le bloc de colonne 13 à 17. Quelqu'un peut il m'aider ?
Voici mon code
Code: 
 :
Option Compare Text
Dim TblBD(), dchoisis1, dchoisis2, dchoisis3, nomtableau, NbCol

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
 
  nomtableau = "tableau1"
  NbCol = Range(nomtableau).Columns.Count
  TblBD = Range(nomtableau).Value
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To Range(nomtableau).Rows.Count
    [COLOR=rgb(250, 197, 28)]tmp = TblBD(i, 13): d(tmp) = ""  [/COLOR][COLOR=rgb(97, 189, 109)]' je pense que mon souci démarre ici
  Next i[/COLOR]
  Me.OptionsGenre.MultiSelect = fmMultiSelectMulti
  Me.OptionsGenre.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionsGenre.List = Tbl
  '--
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To Range(nomtableau).Rows.Count
    tmp = TblBD(i, 18): d(tmp) = ""
  Next i
  Me.OptionsArtiste.MultiSelect = fmMultiSelectMulti
  Me.OptionsArtiste.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionsArtiste.List = Tbl
  '---
   Set d = CreateObject("scripting.dictionary")
  For i = 1 To Range(nomtableau).Rows.Count
    tmp = TblBD(i, 19): d(tmp) = ""
  Next i
  Me.OptionAlbum.MultiSelect = fmMultiSelectMulti
  Me.OptionAlbum.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionAlbum.List = Tbl
  '--
  Me.ListBox1.ColumnCount = Range(nomtableau).Columns.Count + 1
  Me.ListBox1.List = TblBD
  EnteteListBox
End Sub
Private Sub OptionsGenre_change()
  Affiche
End Sub
Private Sub OptionsArtiste_change()
  Affiche
End Sub
Private Sub OptionAlbum_change()
  Affiche
End Sub
Sub Affiche()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsGenre.ListCount - 1
    If Me.OptionsGenre.Selected(i) Then dchoisis1(Me.OptionsGenre.List(i, 0)) = ""
  Next i
  Set dchoisis2 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsArtiste.ListCount - 1
    If Me.OptionsArtiste.Selected(i) Then dchoisis2(Me.OptionsArtiste.List(i, 0)) = ""
  Next i
     Set dchoisis3 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionAlbum.ListCount - 1
    If Me.OptionAlbum.Selected(i) Then dchoisis3(Me.OptionAlbum.List(i, 0)) = ""
  Next i
  Dim Tbl2(): n = 0: Ncol = UBound(TblBD, 2)
  For i = 1 To UBound(TblBD)
    tmp = TblBD(i, 13): tmp2 = TblBD(i, 2): tmp3 = TblBD(i, 3)
    If (dchoisis1.exists(tmp) Or dchoisis1.Count = 0) And (dchoisis2.exists(tmp2) Or dchoisis2.Count = 0) And (dchoisis3.exists(tmp3) Or dchoisis3.Count = 0) Then
        n = n + 1: ReDim Preserve Tbl2(1 To Ncol, 1 To n)
        For k = 1 To Ncol: Tbl2(k, n) = TblBD(i, k): Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl2 Else Me.ListBox1.Clear
  Me.LabelLigne.Caption = n & " élèves"
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
 ref = CStr(a((gauc + droi) \ 2))
 g = gauc: d = droi
 Do
  Do While CStr(a(g)) < ref: g = g + 1: Loop
  Do While ref < CStr(a(d)): d = d - 1: Loop
  If g <= d Then
    temp = a(g): a(g) = a(d): a(d) = temp
    g = g + 1: d = d - 1
  End If
 Loop While g <= d
 If g < droi Then Call Tri(a, g, droi)
 If gauc < d Then Call Tri(a, gauc, d)
End Sub

Sub EnteteListBox()
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 15
   For c = 1 To NbCol
       Set Lab = Me.Controls.Add("Forms.Label.1")
       Lab.Caption = Range(nomtableau).Offset(-1).Item(1, c)
       Lab.ForeColor = vbBlack
       Lab.Top = Y
       Lab.Left = x
       Lab.Height = 15
       Lab.Width = Range(nomtableau).Columns(c).Width * 1#
       x = x + Range(nomtableau).Columns(c).Width * 1
       tempcol = tempcol & Range(nomtableau).Columns(c).Width * 1# & ";"
   Next c
   tempcol = tempcol
   On Error Resume Next
   Me.ListBox1.ColumnWidths = tempcol
   On Error GoTo 0
End Sub

[fin de code]
Merci d'avance
 

Pièces jointes

  • filtre multicritères.xlsm
    603.5 KB · Affichages: 10
Dernière édition:
Trier par date Trier par votes
Y

youpi457032

XLDnaute Occasionnel
job75 à dit:
Au lieu d'un code improbable expliquez en bon français comment vous voulez filtrer.
Cliquez pour agrandir...
bon....
je souhaite filtrer sur plusieurs colonnes pour affiner les criteres les uns apres les autres...
filter de plus en plus finement...
Je gere une association de danse... je souhaite faire apparaitre dans ma liste box tous les elèves qui ont pris les cours selectionnés par le filtre, pour la plage M (colonne 13 ) à Q(colonne 17 incluse).
Ma macro fonctionne tres bien, mais mais que pour la ligne 13, moi il me faut integrer aussi les colonnes 14 à 17... sinon il va me manquer des résultats.... Ce que je souhaite c'est avoir le bout de code macro qui me manque pour filter sur les colonnes 13 à 17 et pas uniquement la 13....
Sinon tout le reste fonctionne bien....
 

Pièces jointes

  • filtre multicritèressource.xlsm
    603.9 KB · Affichages: 8
Vote positif 0 Vote négatif
Y

youpi457032

XLDnaute Occasionnel
youpi457032 à dit:
bon....
je souhaite filtrer sur plusieurs colonnes pour affiner les criteres les uns apres les autres...
filter de plus en plus finement...
Je gere une association de danse... je souhaite faire apparaitre dans ma liste box tous les elèves qui ont pris les cours selectionnés par le filtre, pour la plage M (colonne 13 ) à Q(colonne 17 incluse).
Ma macro fonctionne tres bien, mais mais que pour la ligne 13, moi il me faut integrer aussi les colonnes 14 à 17... sinon il va me manquer des résultats.... Ce que je souhaite c'est avoir le bout de code macro qui me manque pour filter sur les colonnes 13 à 17 et pas uniquement la 13....
Sinon tout le reste fonctionne bien....
Cliquez pour agrandir...
Bonsoir,
comment je l'ecris ??
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re, salut ChTi160,

Je n'ai pas essayé de comprendre ce que vous voulez faire avec votre UserForm et ses ListBox.

En tout cas je n'en vois pas l'utilité pour filtrer.

Voyez le fichier joint et ces 2 macros :
VB: 
Sub Filtrer()
Dim col, i%, x$, critere$
col = Array("M", "N", "O", "P", "Q")
For i = 0 To UBound(col)
    x = Application.InputBox("Critere colonne " & col(i), Type:=2)
    If x <> "" Then critere = critere & ",ISNUMBER(SEARCH(""" & x & """," & col(i) & "3))"
Next
If critere = "" Then Exit Sub
With Sheets("BD") 'la ligne 1 doit rester vide
    .[S3] = "=AND(" & Mid(critere, 2) & ")" 'formule du critere
    .[A2].CurrentRegion.AdvancedFilter xlFilterInPlace, .[S2:S3]
    .[S3] = ""
End With
End Sub

Sub RAZ()
With Sheets("BD")
    If .FilterMode Then .ShowAllData
End With
End Sub
A+
 

Pièces jointes

  • filtre multicritèressource(1).xlsm
    47 KB · Affichages: 7
Vote positif 0 Vote négatif
Y

youpi457032

XLDnaute Occasionnel
job75 à dit:
Re, salut ChTi160,

Je n'ai pas essayé de comprendre ce que vous voulez faire avec votre UserForm et ses ListBox.

En tout cas je n'en vois pas l'utilité pour filtrer.

Voyez le fichier joint et ces 2 macros :
VB: 
Sub Filtrer()
Dim col, i%, x$, critere$
col = Array("M", "N", "O", "P", "Q")
For i = 0 To UBound(col)
    x = Application.InputBox("Critere colonne " & col(i), Type:=2)
    If x <> "" Then critere = critere & ",ISNUMBER(SEARCH(""" & x & """," & col(i) & "3))"
Next
If critere = "" Then Exit Sub
With Sheets("BD") 'la ligne 1 doit rester vide
    .[S3] = "=AND(" & Mid(critere, 2) & ")" 'formule du critere
    .[A2].CurrentRegion.AdvancedFilter xlFilterInPlace, .[S2:S3]
    .[S3] = ""
End With
End Sub

Sub RAZ()
With Sheets("BD")
    If .FilterMode Then .ShowAllData
End With
End Sub
A+
Cliquez pour agrandir...
Merci d'avoir pris du temps....
Maic ce n'est pas ce type de fonction de filtrage que je recherche...
Je souhaite garder mes resultats dans mon userform (sous formulaire)...
Je souhaite juste que le critère " choix du cours de danse" filtre sur les colonnes M à Q en même temps, et pas M uniquement.... l'idée finale étant pour tout vous avouer faire du mailing ciblé... en exportant les resultats du sous formulaires vers une feuille resutlat_filtre, récuperer les adresses mail... et tout exporter dans outlook ( cette derniere partie est dejà fonctionnelle)...
Merci
 
Vote positif 0 Vote négatif
Y

youpi457032

XLDnaute Occasionnel
ChTi160 à dit:
Re
dommage que tu n'est pas mis la solution a ton problème (partage)
moi j'avais travaillé la dessus!
dommage !
jean marie
Cliquez pour agrandir...
je te joins mon fichier modifié des que je l'ai anonymisé....
je te remerercie d'avoir pris du temps
j'aurai encore besoin d'aide je pense....
comme par exemple associé en Vba une liste de cours à un in nom d'intervenant et l'ecrire ligne par ligne dans 5 colonnes différentes....
ex : choix du cours UN en colonne M = Bachata, ecrire en colonne "s" le nom de l'intervenant "Chou",
pour la même cellule si le cours corrsepond à un autre intervenant faire correspondre le bon nom d'intervenant...
Tu penses que tu pourrais travailler là-dessus?
je te donne le tableau :
colonne M : cours 1 (ex salsa, bachata, rock.....etc ) ----> colonne S ---Nom de l'intervenant ( parmi une liste d'intervenant : CHAQUE intervenant ayant sa liste de cours ! )
Colonne N : cours 2 (ex salsa, bachata, rock.....etc ) ----> colonne T ---Nom de l'intervenant ( parmi une liste d'intervenant)
Colonne O : cours 3 (ex salsa, bachata, rock.....etc ) ----> colonne U ---Nom de l'intervenant ( parmi une liste d'intervenant)
Colonne P : cours 4 (ex salsa, bachata, rock.....etc ) ----> colonne V ---Nom de l'intervenant ( parmi une liste d'intervenant)
Colonne Q : cours 5 ((ex salsa, bachata, rock.....etc ) ----> colonne W ---Nom de l'intervenant ( parmi une liste d'intervenant)
L'idée étant de pouvoir filter par intervenant.... (toujours selon le même principe)
 

Pièces jointes

  • filtre multicritères travail.xlsm
    612.2 KB · Affichages: 12
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Amigo
  • Question
XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier
2 3
Réponses
33
Affichages
941
Amigo
Amigo
Regueiro
  • Question
Microsoft 365 Format Nombre Combobox dans Feuille
Réponses
3
Affichages
358
fanch55
fanch55
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
485
AtTheOne
AtTheOne
patricktoulon
  • Question
Autres la fonction similaire
Réponses
11
Affichages
357
patricktoulon
patricktoulon
C
  • Résolu(e)
XL 2021 Additionner résultats d'une boucle for en vba
Réponses
9
Affichages
371
Claudinedu13
C
C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
487
Claudinedu13
C
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
P
  • Résolu(e)
XL 2013 EXCEL VBA
Réponses
2
Affichages
303
pangasoul
P
cathodique
  • Question
XL 2010 Comptage Complexe
2 3
Réponses
40
Affichages
2 K
dysorthographie
dysorthographie
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
328
Minus&Cortex
M

Membres actuellement en ligne

15 membres et 164 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 705
Messages
2 112 073
Membres
111 410
dernier inscrit
yomeiome