使用combobox并单击以筛选Excel中单独的工作表上的数据

我一直在寻找几天，但似乎无法解决这个问题。

我有一个Excel工作簿，其中包含来自Access数据库的“创意”列表。 在Excel表格“AllIdeas”上以只读模式连接（绝对不希望Excel写回Access！）

一些注意事项：工作表“AllIdeas”最初将被隐藏。 VBAmacros将取消隐藏并过滤它。

我有一个标题为“仪表板”，我想要以下function：

1. （不工作）想法所有者可以使用combobox并单击一个“button”（在这种情况下，它是一个圆angular矩形，我将分配一个macros）来过滤“AllIdeas”上的信息，只显示分配给他们的想法。
2. （不工作）我想另一个combobox列出思想的“状态”（打开，拒绝，实施等）以及一个可点击的圆angular矩形。 该矩形的macros只需要拉取意见主人（在combobox1中标识）和状态（在combobox2中标识）的意见。 这个第二个“button”macros不会运行没有意见所有者和状态select。
3. （工作）用户可以input想法编号，并在仪表板上popup信息。 这是有用的，如果他们知道一个想法编号，但需要的细节。
4. （工作）在仪表板的底部有另一个圆angular矩形，分配了一个macros，取消隐藏“AllIdeas”表并显示整个表。
5. （工作）在“AllIdeas”表单上有一个标有“点击此处返回仪表板”的button。 此macros将用户返回仪表板并隐藏“AllIdeas”表。

这是我所拥有的一些东西。 我提前道歉，这可能是多么混乱…这是我第一次冒险进入VBA：

Sub AllIdeasBtn() Worksheets("AllIdeas").Visible = xlSheetVisible Worksheets("AllIdeas").Activate If Worksheets("AllIdeas").AutoFilterMode Then Worksheets("AllIdeas").ShowAllData End Sub Sub Back() ActiveSheet.Visible = False Sheets("Dashboard").Select Sheets("AllIdeas").Visible = False End Sub 

我完全停留在如何使用我的comboBoxes和点击macros来取消隐藏AllIdeas表单，并通过combobox中的select来过滤它。 AllIdeas示例

Answer 1

jrichall – 这个答案是提供一个框架和示例，来帮助解决你的问题。 它不会完全按照您的devise进行布置。

我已经把它分解了

1. AllIdeas表中存在唯一的名称，状态，想法编号等必需的列表。 这些列表用于限制最终用户的筛选select，但是它们需要随着内容更改而保持最新。
2. 您一次只能将最终用户限制为一种filter，无论是按名称，状态，创意编号还是其他方式。 这意味着您需要一种方法来消除一种filter时，另一种被选中。
3. 在应用新filter之前，AllIdeas的旧过滤需要被消除。
4. 在仪表板上显示过滤结果意味着保持仪表板外观。

注意：在我的例子中，我没有使用combobox。 但是，这些概念很容易运输。

---

一个简单的AllIdeas

为了testing代码，生成了一个简单的AllIdeas模型…

---

一个简单的仪表板

一个简单的仪表板也放在一起。 其中，单元格A2，B2和C2的input使用数据validation进行保护。

一个命名的Range定义了有效的数据。 以上图示为名称范围“名称”。

---

列出并维护它们

有效名称，状态和数字（命名范围）列表保存在名为“DropDowns”的选项卡上。 它看起来像下面…

您可以看到这些列表不包含AllIdeas表中包含的所有信息。 下面是更新“名称”列表的VBA代码。 类似的更新“状态”列表和“数字”列表。

 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 

运行这些例程之后，现在命名的范围列表如下所示：

这些例程被添加到WorkBook_Open事件代码，所以他们保持最新的用户…

 Private Sub Workbook_Open() UpdateNamesList UpdateStatusList UpdateNumberList End Sub 

现在，用户下拉列表是最新的（类似的方法可以用来保持combobox是最新的）…

---

过滤 – 只能有一个！

要在单元格B2中指定某些内容时pipe理单元格A2中的清除筛选或三个筛选器规范中的所有其他更改组合，将使用控制板的WorkSheet_Change事件代码…

 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 

现在，select一个filter自动清除其他…

---

过滤和显示

“FetchIdeas”button连接到下面一块VBA代码…

 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 

它应用filter，清除仪表板，并将新的过滤数据放置在仪表板上…