Question

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

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

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

我有一张标题为“仪表板”的表格，我想要以下功能：

（不工作）想法所有者可以使用ComboBox并单击“按钮”（在这种情况下，它是一个圆角矩形，我将指定一个宏）来过滤“AllIdeas”上的信息，仅显示想法分配给他们。
（不工作）我想要另一个ComboBox列出Ideas（Open，Declined，Implemented等）的“Status”以及可点击的圆角矩形。此矩形的宏只需要提取想法所有者（在combobox1中标识）和状态（在combobox2中标识）的想法。如果没有选择构思所有者和状态，则第二个“按钮”宏将无法运行。
（工作）用户可以输入构思编号并在仪表板上弹出信息。如果他们知道一个想法编号，但需要详细信息，这很有用。
（工作）在仪表板的底部有另一个圆角矩形，其中指定了一个宏，用于取消隐藏“AllIdeas”表并显示整个表格。
（工作）在“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 Sheet并通过组合框中的选择对其进行过滤。 AllIdeas Example

Answer 1

jrichall - 这个答案是提供一个框架，带有示例，以帮助解决您的问题。它并没有像你设计的那样完全解决问题。

我已经这样打破了......

AllIdeas表中存在的唯一名称，状态，构思号等需要列表。这些列表用于限制最终用户的过滤选择，但是当内容发生变化时，它们需要保持最新。
您一次将最终用户限制为一种过滤器 - 通过名称，状态，创意号或其他内容。这意味着您需要一种方法来在选择另一种时消除一种过滤器。
在应用新过滤器之前，需要消除旧的AllIdeas过滤。
在仪表板上显示过滤结果意味着维护仪表板外观。

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

简单的AllIdeas

为了测试代码，生成了一个简单的AllIdeas模型......

简单的信息中心

一个简单的仪表板也放在一起。其中，单元格A2，B2和C2使用数据验证保护其输入。

命名范围定义有效数据。上面说明的是名为Range＆＃34; Names＆＃34;。

列出并维护

有效名称，状态和号码（命名范围）列表保存在名为＆＃34; DropDowns＆＃34;的选项卡上。它看起来像以下......

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

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

现在，用户已下载最新的列表（类似的方法可用于使组合框保持最新）...

过滤 - 只能有一个！

要在Cell B2中指定某些内容时在Cell 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

现在，选择一个过滤器会自动清除另一个...

过滤和显示

＆＃34; FetchIdeas＆＃34;按钮连接到以下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

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

使用组合框并单击以在Excel中的单独工作表上过滤数据

1 个答案: