值数组的Vlookup

Question

ManagerEmployeeSheet

     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

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

DashboardSheet

    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 

因此，当我在单元格管理器( cell B1 of DashboardSheet )中输入B1管理器时，我应该将所有员工置于他下面的单元格中，类似地，如果我输入任何其他管理器，则应该将所有员工置于该管理器之下。仅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做什么，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")，查看结果并发送一些反馈。