使用組合框，然後單擊以另紙在Excel

Question

我一直在尋找了幾天過濾數據，但似乎無法來解決這一問題。

我有一個Excel工作簿，裏面的從Access數據庫「想法」的列表。在Excel表格「AllIdeas」中，表格以只讀模式連接（絕對不希望Excel寫回Access！）「AllIdeas」

一些注意事項：工作表「AllIdeas」最初將被隱藏。 VBA宏將取消隱藏並過濾它。

我有一個表名爲「儀表板」，我想下面的功能：

1. （不工作）理念業主可以使用ComboBox並單擊「按鈕」（在這種情況下，這是一個圓角矩形我將分配一個宏）來過濾「AllIdeas」上的信息，只顯示分配給他們的想法。
2. 有一個可點擊的圓角矩形沿（不工作），我想另一個組合框列出理念的「狀態」（開放，謝絕，實施等）。這個矩形的宏需要只提取想法擁有者的想法（在combobox1中標識）和狀態（在combobox2中標識）。如果未選擇主意所有者和狀態，則第二個「按鈕」宏將不會運行。
3. （工作中）用戶可以輸入想法編號並在儀表板上彈出信息。如果他們知道想法編號，但是需要詳細信息，這很有用。
4. （工作）在儀表板的底部，還有另外一個圓角矩形分配的宏取消隱藏「AllIdeas」片材，並顯示整個表。
5. （工作）在「AllIdeas」表單上有一個標籤爲「單擊此處返回儀表板」的按鈕。此宏將用戶返回到儀表板並隱藏「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 

我完全被卡住關於如何使用我的組合框與點擊宏一起取消隱藏AllIdeas表和篩選器它由組合框中的選擇組成。 AllIdeas Example

Answer 1

jrichall - 這個答案是提供一個框架和示例，以幫助解決您的問題。它不會完全按照您的設計進行佈置。

我打破了下來，這樣......都需要唯一的名稱，狀態，思想號碼等，在AllIdeas表存在

1. 列表。這些列表用於限制最終用戶的篩選選擇，但它們需要在內容更改時保持最新。
2. 你限制了最終用戶的一種過濾器在同一時間 - 無論是按名稱，狀態，數量理念，還是其他什麼東西。這意味着您需要一種方法來消除另一種選擇時的一種過濾器。
3. 在應用新過濾器之前，需要消除AllIdeas的舊過濾。
4. 在儀表板上顯示過濾結果意味着保持儀表板外觀。

注意：在我的示例中，我沒有使用組合框。但是，這些概念很容易運輸。

---

簡單AllIdeas

要測試的代碼，產生AllIdeas的一個簡單的樣機......

---

一個簡單的儀表板

一個簡單的儀表盤也放在一起。其中，單元格A2，B2和C2使用數據驗證來保護其輸入。

命名範圍定義了有效的數據。上面所示的是名爲範圍「名稱」。

---

列表和維護他們

有效的名稱，狀態和號碼（指定範圍）的列表是維持一個名爲「下拉菜單」選項卡上。它看起來像下面...

你可以看到這些列表不包含所有包含在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 

現在，用戶有下拉列表是最新的（類似的方法可以用來保持組合框爲最新）。 。

---

過濾 - 只能有一個！

爲了管理當在單元格B2，或者在這三個過濾器規格的變化的所有其它組合中指定的東西清除單元格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 

現在，選擇一個過濾器會自動清除其他...

---

過濾和顯示

的 「FetchIdeas」 按鈕被連接到下面的一段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 

它適用於過濾器，清除儀表盤，並把儀表盤上的新filterd數據...