À l'aide d'une combobox et cliquez pour filterr datatables sur une feuille séparée dans Excel

jrichall – Cette réponse est de fournir un cadre, avec des exemples, pour résoudre votre problème. Il ne pose pas les choses exactement comme vous l'avez conçu.

Je l'ai cassé de cette façon …

1. Les lists sont requirejses pour les noms uniques, le statut, les nombres d'idées, etc., qui existent sur la table AllIdeas. Ces lists sont utilisées pour limiter les choix des users finaux pour le filtrage, mais ils doivent être tenus à jour lorsque le contenu change.
2. Vous limitez l'user final à un type de filter à la fois – soit par Nom, Statut, Numéro d'Idée, soit par autre chose. Cela signifie que vous avez besoin d'un moyen d'éliminer un type de filter lorsque l'autre est choisi.
3. L'ancien filtrage d'AllIdeas doit être éliminé avant qu'un nouveau filter ne soit appliqué.
4. L'affichage des résultats filtrés sur le tableau de bord signifie maintenir l'apparence du tableau de bord.

Remarque: Dans mon exemple, je n'utilise pas les boîtes combinées. Cependant, les concepts sont facilement transportables.

Un AllIdeas simple

Pour tester le code, une simple modélisation de AllIdeas a été générée …

Un tableau de bord simple

Un tableau de bord simple a également été mis en place. Dans ce cas, les cellules A2, B2 et C2 ont leur input protégée à l'aide de la validation des données.

Une gamme nommée définit datatables valides. L'Illustré ci-dessus est l'appellation Range "Names".

Lister et les maintenir

Les lists des noms, des états et des numéros valides (gammes nommées) sont conservées sur un onglet nommé "DropDowns". Il ressemble à ce qui suit …

Vous pouvez voir ces lists ne contiennent pas toutes les informations contenues dans la table AllIdeas. Ci-dessous le code VBA pour mettre à jour la list "Noms". D'autres sont disponibles pour la mise à jour de la list "Statut" et de la list "Numéros".

 Sub UpdateNamesList() Dim IdeaSht As Worksheet, ListSht As Worksheet Dim IdeaRng As Range, myRng As Range Dim iCount As Long, NameCol As Long Dim myDict As Object, myKey As Variant Dim namedRange As Name ' Initial Set IdeaSht = Worksheets("AllIdeas") Set ListSht = Worksheets("DropDowns") Set myDict = CreateObject("Scripting.Dictionary") ' Find the column with the user names For Each myRng In IdeaSht.Range(IdeaSht.Cells(1, 1), IdeaSht.Cells(1, IdeaSht.Cells(1, IdeaSht.Columns.Count).End(xlToLeft).Column)) If myRng.Value = "Idea Owner" Then NameCol = myRng.Column Exit For End If Next myRng ' Pull out unique user names For Each myRng In IdeaSht.Range(IdeaSht.Cells(2, NameCol), IdeaSht.Cells(IdeaSht.Range("A" & IdeaSht.Rows.Count).End(xlUp).Row, NameCol)) If Not myDict.exists(myRng.Value) Then myDict.Add myRng.Value, myRng.Value End If Next myRng ' Change "Names" list to contain the unique user names For Each myRng In ListSht.Range(ListSht.Cells(1, 1), ListSht.Cells(1, ListSht.Cells(1, ListSht.Columns.Count).End(xlToLeft).Column)) If myRng.Value = "Names" Then NameCol = myRng.Column Exit For End If Next myRng iCount = 0 For Each myKey In myDict ListSht.Cells(2 + iCount, NameCol).Value = myKey iCount = iCount + 1 Next myKey Set namedRange = ActiveWorkbook.Names("Names") namedRange.RefersTo = ListSht.Range(ListSht.Cells(2, NameCol), ListSht.Cells(1 + iCount, NameCol)) ' clean up Set IdeaSht = Nothing Set ListSht = Nothing Set myDict = Nothing Set namedRange = Nothing End Sub 

Après avoir exécuté ces routines, les lists de gamme nommées apparaissent comme suit …

Ces routines sont ajoutées au code WorkBook_Open Event, afin de restr à jour pour l'user …

 Private Sub Workbook_Open() UpdateNamesList UpdateStatusList UpdateNumberList End Sub 

Maintenant, l'user a des lists déroulantes qui sont à jour (une méthode similaire pourrait être utilisée pour garder les boîtes à genoux mises à jour) …

Filtrage – il ne peut y en avoir qu'un!

Pour gérer le filtrage du filtrage dans la cellule A2 lorsque quelque chose est spécifié dans la cellule B2 ou toutes les autres combinaisons de modifications dans les trois spécifications du filter, le code d'événement WorkSheet_Change pour le tableau de bord a été utilisé …

 Private Sub Worksheet_Change(ByVal Target As Range) Dim iLoop As Long If Intersect(Target, ActiveSheet.Range("A2:C2")) Is Nothing Then Exit Sub Application.EnableEvents = False For iLoop = 1 To 3 If Target.Column <> iLoop Then ActiveSheet.Cells(2, iLoop).Value = "" Next iLoop Application.EnableEvents = True End Sub 

Maintenant, choisir un filter efface automatiquement l'autre …

Filtrage et affichage

Le button "FetchIdeas" est connecté au code VBA suivant …

 Sub FetchAllIdeas() Dim IdeaSht As Worksheet, DshbrdSht As Worksheet Dim myRng As Range Dim lstRow As Long, lstCol As Long Dim FltrVal() As Variant, FltrCol As Long Dim myField As Long, iLoop As Long 'Initial Set IdeaSht = Worksheets("AllIdeas") Set DshbrdSht = Worksheets("Dashboard") 'Determine which filter we are using ReDim FltrVal(1 To 1) myField = 0 For Each myRng In DshbrdSht.Range("A2:C2") If myRng.Value <> "" Then FltrVal(1) = myRng.Value If myRng.Offset(-1, 0).Value = "GetByName" Then myField = 2 If myRng.Offset(-1, 0).Value = "GetByStatus" Then myField = 3 If myRng.Offset(-1, 0).Value = "GetByNumber" Then myField = 1 Exit For End If Next myRng 'Clear the dashboard lstRow = DshbrdSht.Range("A" & DshbrdSht.Rows.Count).End(xlUp).Row For iLoop = lstRow To 5 Step -1 DshbrdSht.Cells(iLoop, 1).EntireRow.Delete Next iLoop 'Filter the AllIdeas tab If myField > 0 Then lstRow = IdeaSht.Range("A" & IdeaSht.Rows.Count).End(xlUp).Row lstCol = IdeaSht.Cells(1, IdeaSht.Columns.Count).End(xlToLeft).Column With IdeaSht .Cells.AutoFilter With .Range(IdeaSht.Cells(1, 1), IdeaSht.Cells(lstRow, lstCol)) .AutoFilter field:=myField, Criteria1:=FltrVal ' and display on the dashboard .SpecialCells(xlCellTypeVisible).Copy Destination:=DshbrdSht.Range("A5") End With End With End If End Sub 

Il applique les filters, efface le tableau de bord et met les nouveldatatables filtrées sur le tableau de bord …