Question

我有一张包含员工和数据的电子表格。 A1中的下拉列表允许某人选择该员工，然后为所有其他员工隐藏行。我想在A1的下拉列表中添加主管的名称，并让它只选择该主管下的员工并隐藏其余的。每位主管的员工人数从3到6不等。这是我在选择单个员工时隐藏行的方法：数据在工作表1上，员工和主管列表在sheet2上

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant, i, j As Long
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    ActiveWindow.FreezePanes = False

    UsedRange.Rows.Hidden = False
    If IsEmpty(Cells(1, 1)) Then Exit Sub
    v = Cells(1, 1).Value
    For i = 2 To 40 ' Show/Hide the Analysts rows - Add/Substract to the second number when adding/removing analysts
        If Not Cells(i, 1) = v Then Rows(i).Hidden = True
        If v = "Select Analysts/Supervisors" Then Rows(i).Hidden = False
    Next i


    Cells(2, 1).Select
    ActiveWindow.FreezePanes = True
    Cells(2, 1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

有人对如何做到这一点有任何想法吗？我正在使用Excel 2010

Answer 1

我希望我能正确理解你的问题，并且优秀的工作簿结构。

您必须在数据表上创建范围（在此示例中为其命名范围：'rngSupervisors'）
在此范围内，您可以设置主管名称（列标题）
在每个主管下，你都要写员工。每排1名员工。

主管本身必须在您的员工列表中进行选择，以便下拉。

所以数据工作表有以下示例：

B1：主管1 C1：主管2 D1：supervisor3

比员工
B2：emplyee1_UnderSupervisor1
B2：emplyee2_UnderSupervisor1
B2：emplyee3_UnderSupervisor1

C2：emplyee1_UnderSupervisor2
C2：emplyee2_UnderSupervisor2
。
。

然后你必须将这个范围“B1：D1”命名为“rngSupervisors”

在此示例中，数据工作表是第二个。我建议你使用命名工作表，或者更好地直接引用它（在VBA编辑器中给出工作表的名称，而不是直接引用它）。

这里我创建了一个函数，用于测试Argument1-string是否是Argument2-string的顾问程序。你可以使用这个函数来测试它，如果它是假的，并且名称不匹配，那么你可以隐藏行。

我试图对你的代码进行微小的修改（但它可以很好地改进..或者你完成它的方法，可能可以用excel过滤器实现）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant, i, j As Long
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    ActiveWindow.FreezePanes = False

    UsedRange.Rows.Hidden = False
    If IsEmpty(Cells(1, 1)) Then Exit Sub
    v = Cells(1, 1).Value
    For i = 2 To 40 ' Show/Hide the Analysts rows - Add/Substract to the second number when adding/removing analysts
        'if the name is not under selected supervisor, and its not selected name, hide the row
        If Not isSupervisor(CStr(v), CStr(Cells(i, 1).Value)) And Not Cells(i, 1) = v Then
            Rows(i).Hidden = True
        End If
    Next i


    Cells(2, 1).Select
    ActiveWindow.FreezePanes = True
    Cells(2, 1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

'returns true if sEmplName is under sSupName supervisor
Private Function isSupervisor(sSupName As String, sEmplName As String) As Boolean
    Dim wksDataSheet As Worksheet 'worksheet where supervisor and employes data saved
    Dim rngSupCell As Range 'range with supervisor names/headers
    Dim lSupColumn As Long 'column of selected supervisor
    Dim lSupLastRow As Long 'last row with employes names of column of supervisor
    Dim lCurrentRow As Long 'counter for current row by iteration

    Set wksDataSheet = ThisWorkbook.Sheets(2) 'or some named sheet for example ThisWorkbook.Sheets("DataSheet")

    With wksDataSheet
        'for each cell in supervisor names range
        For Each rngSupCell In .Range("rngSupervisors") 'could be .Range("A3:A6") for example
            'if supervisor name found in the range
            If StrComp(rngSupCell.Value, sSupName, vbTextCompare) = 0 Then
                'get column
                lSupColumn = rngSupCell.Column
                'get last row
                lSupLastRow = .Cells(.Rows.Count, "A").End(xlUp).row
                'for each employee name, starts from next row
                For lCurrentRow = rngSupCell.row + 1 To lSupLastRow
                    'if equals, return true, exit.
                    If StrComp(.Cells(lCurrentRow, lSupColumn).Value, sEmplName, vbTextCompare) = 0 Then
                        isSupervisor = True
                        Exit Function
                    End If
                Next lCurrentRow
            End If
        Next rngSupCell
    End With

    'nothing found, return false
    isSupervisor = False
End Function

根据A1的值选择多行

1 个答案: