Question

我有一个电子表格，其中包含一个范围内不同类型项目的所有可能项目任务的列表，以及该范围内的一列，指出了该项目与哪个项目有关。

在单元格A1中，我有一个不同项目类型的下拉框-包含值“ Custom API”和“ Custom File”。

数据范围为C3：E10，示例数据显示在示例数据中。

Column A: Task name
Column B: Task Duration
Column C: Task Owner
Column D: Project Type

我想从一些vba代码中得到的是：

从A1的下拉列表中选择“自定义API”时，将显示项目类型为“全部”和“自定义API”的范围内的所有任务，而所有“自定义文件”项目任务行将被隐藏。
从A1的下拉列表中选择“自定义文件”时，将显示项目类型为“全部”和“自定义文件”的范围内的所有任务，并隐藏所有“自定义API”项目任务行。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Address = "$A$1" and Target.Cells.Count = 1 Then

    Application.ScreenUpdating = False
    Range("B4:E10").EntireRow.Hidden = False
    Dim taskList as Range
    Set taskList = Range(Range("E4"),Range("E4").End(xlDown))

    Dim taskCheck as Range
    For each taskCheck in taskList
        taskCheck.EntireRow.Hidden = taskCheck <> Target
    Next

  End If

End Sub

Answer 1

您实际上只是在设置自动过滤器而没有标题下拉列表。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$A$1" Then

        Range("B4:E10").EntireRow.Hidden = False
        If AutoFilterMode Then AutoFilterMode = False
        With Range(Cells(3, "E"), Cells(4, "E").End(xlDown))
            .AutoFilter field:=1, Criteria1:=Array(Cells(1, "A").Value, "All"), _
                        Operator:=xlFilterValues, VisibleDropDown:=False
        End With

    End If

End Sub

您可以清除自动过滤器，并在A1下拉列表的值列表中添加星号（例如*）以显示所有值。

Answer 2

请尝试使用此代码。确保A1中项目的拼写与测试栏中的拼写匹配。

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 03 Jan 2019

    ' set these two constants to match your sheet
    Const FirstDataRow As Long = 4
    Const TestClm As String = "E"

    Dim Rng As Range
    Dim Arr As Variant
    Dim Tgt As String
    Dim C As Long
    Dim R As Long

    ' (If the address is $A$1 it can't have more than one cell)
    If Target.Address = "$A$1" Then
        Tgt = Target.Value
        Rows.Hidden = False
        C = Columns(TestClm).Column
        Set Rng = Range(Cells(FirstDataRow, C), Cells(Rows.Count, C).End(xlUp))
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        With Rng
            Arr = .Value
            For R = 1 To UBound(Arr)
                Rows(R + FirstDataRow - 1).Hidden = Not (CBool(StrComp(Arr(R, 1), Tgt, vbTextCompare) = 0) Or _
                                                    CBool(StrComp(Arr(R, 1), "All", vbTextCompare) = 0))
            Next R
        End With
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

隐藏电子表格范围中包含值的行

2 个答案: