Vlookup 查找一组值

Question

经理员工表

     A           B
1  manager    Employee
2  M1          E1
3  M1          E2
4  M1          E44
5  M1          E41
6  M1          E34
7  M2          E100
8  M2          E17
9  M2          E29 and so on

我正在制作一个动态仪表板，我需要在其中动态反映每个经理下的员工。

仪表板表

    A                    B
1  Input Manager      M1    #basically user inputs one manager name here in this cell
2  E1
3  E2
4  E44
5  E41
6  E34 

因此，当我在 DashboardSheet 的单元格 B1 中输入 M1 经理时，我应该在下面的单元格中得到他下面的所有员工，同样，如果我输入任何其他经理，我应该得到该经理下的所有员工。单独的 Vlookup 只会返回与经理对应的第一个员工，但我需要他下面的所有员工。

我已经读到vlookup 和offset 可以做到这一点。但我不确定。

有人可以帮忙吗？

Answer 1

如果您有Office365，那么您可以使用Filter 公式轻松做到这一点。根据屏幕截图尝试以下公式。

=FILTER(B2:B9,A2:A9=E1)

如果您没有Office365，请一起使用INDEX() 和AGGREGATE() 公式。根据我的屏幕截图，将以下公式用于D2 单元格。

=IFERROR(INDEX($B$2:$B$9,AGGREGATE(15,6,ROW($1:$9)/($A$2:$A$9=$E$1),ROW(1:1))),"")

Answer 2

我一开始就断言@Harun24HR 可以用一个公式做的事情 VBA 应该可以用一行代码做的事情变成了如下所示的史诗般的努力。显然我失败了。在该项目的辩护中，我指出，如果您在工作表中有公式，您应该为工作表添加保护，以防止您的公式被损坏，这也大大增加了管理工作。

话虽如此，下面的代码是一个 Worksheet_Change 过程，它必须位于仪表板工作表的代码模块中，并响应单元格 B1 中的更改（TriggerRange）。它调用的函数可以和它一起去同一个位置。调整代码顶部的 3 个常量（@Harun 无法提供便利，因为这是使用 VBA 的优势之一）。关键是您可以修改 3 个常量中的任何一个或全部，而无需触及其余代码。这让整个管理变得更加容易。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 083
    
    Const TriggerRange  As String = "B1"        ' cell where the change occurs
    Const MgrClm        As String = "A"         ' change to suit
    Const EmpClm        As String = "C"         ' change to suit

    
    Dim List            As Variant              ' list of employees under one manager
    Dim OutputRng       As Range                ' range to write result to
    
    With Target
        If .Address(0, 0) = TriggerRange Then
            Set OutputRng = Range(.Offset(1), Cells(.Rows.Count, .Column).End(xlDown))
            ' keep one blank between the last employee and any other column content
            OutputRng.ClearContents
            List = EmployeeList(.Value, Columns(MgrClm).Column, Columns(EmpClm).Column)
            ' write to the cell below the changed cell
            Set OutputRng = .Offset(1).Resize(UBound(List))
            OutputRng.Value = Application.Transpose(List)
        End If
    End With
End Sub

Private Function EmployeeList(ByVal Crit As String, _
                              ByVal MgrClm As Long, _
                              ByVal EmpClm As Long) As Variant
    ' 083

    Dim Fun         As Variant                  ' function return array
    Dim FltMode     As Boolean                  ' Filter set by user
    Dim Rng         As Range                    ' working range
    Dim RngArea     As Range                    ' areas of the filtered range
    Dim n           As Long                     ' index to Fun
    Dim R           As Long                     ' loop counter: Rows

    With Worksheets("Employees")
        If .AutoFilterMode Then
            .Cells.AutoFilter
            FltMode = True
        End If
        
        Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, EmpClm).End(xlUp))
        With Rng
            ReDim Fun(1 To .Rows.Count)
            .AutoFilter
            .AutoFilter Field:=MgrClm, Criteria1:=Crit
        End With

        On Error Resume Next
        Set Rng = .AutoFilter.Range.Offset(1, 0) _
                  .Resize(.AutoFilter.Range.Rows.Count - 1) _
                  .SpecialCells(xlCellTypeVisible)      ' omit header row
        If Err.Number = 0 Then
            On Error GoTo 0
            For Each RngArea In Rng.Areas
                With RngArea
                    For R = 1 To .Rows.Count
                        n = n + 1
                        Fun(n) = .Cells(R, EmpClm).Value
                    Next R
                End With
            Next RngArea
        End If
        If Not FltMode Then .AutoFilter
    End With

    If n = 0 Then
        n = 1
        Fun(n) = "No subordinates"
    End If
    ReDim Preserve Fun(1 To n)

    EmployeeList = Fun
End Function

Answer 3

请尝试下一个 VBA 方法：

1. 在标准模块中复制下一个Sub。它将创建一个验证单元，保留唯一的 Manager 名称（不是必需的，但我认为很有帮助）：

Sub setValidationUnique()
  Dim shM As Worksheet, shD As Worksheet, rngV As Range, dict As Object
  Dim lastRM As Long, i As Long
  
  Set shM = Worksheets("ManagerEmployeeSheet")'use here your sheet name
  Set shD = Worksheets("DashboardSheet")      'use here your sheet name
  lastRM = shM.Range("A" & Rows.count).End(xlUp).row
  
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 2 To lastRM
    dict(shM.Range("A" & i).value) = 1
  Next i

  Set rngV = shD.Range("B1")
  With rngV.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:=Join(dict.Keys, ",")
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
  End With
  With shD.Range("A1")
    .value = "Input Manager"
    .Font.Bold = True
    .EntireColumn.AutoFit
  End With
  shD.Activate: rngV.Select
End Sub

1. 在工作表“DashboardSheet”模块中，复制下一个事件：

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B1" Then Exit Sub
    Dim shM As Worksheet, arrE As Variant, k As Long
    Dim lastRM As Long, i As Long
    
    Set shM = Worksheets("ManagerEmployeeSheet")
    lastRM = shM.Range("A" & Rows.count).End(xlUp).row
    ReDim arrE(0 To lastRM)
    
    For i = 2 To lastRM
        If shM.Range("A" & i).value = Target.value Then
            arrE(k) = shM.Range("B" & i).value: k = k + 1
        End If
    Next i
    ReDim Preserve arrE(k - 1)
    Target.Parent.Range(Target.Offset(1, -1), Target.Offset(1, -1).End(xlDown)).Clear
    Application.EnableEvents = False
    Target.Offset(1, -1).Resize(UBound(arrE) + 1, 1).value = WorksheetFunction.Transpose(arrE)
    Application.EnableEvents = True
End Sub

注意适当命名必要的工作表，或将其命名为“ManagerEmployeeSheet”和“DashboardSheet”。

使用经过验证的单元格（“B1”），查看结果并发送一些反馈。