根据单元格值将项目添加到动态下拉列表

Question

这是一个关于是否可以在 excel 中做我想做的事情的问题。我有一个看起来像这样的案例列表：

还有一个看起来像这样的相遇表格：

在会见表上，我想制作一个下拉列表，其中仅包含分配给特定案例经理的人员姓名。因此，如果我在 CM 列中输入 SH，则只有 Caselist 表中“Assigned CM”为 SH 的案例才会填充下拉菜单。

这可以在 Excel 中完成吗？感谢您的帮助。

Answer 1

您可以尝试下面给出的代码。 该代码假定您在工作簿中有两张名为“Encounter”和“CaseList”的工作表。两张纸上的标题都在第 1 行。在 Encounter Sheet 上，A 列包含 CM（用于选择 CM 的下拉菜单），B 列将插入一个依赖下拉列表，该列表由代码插入，以根据 col 中选择的 CM 选择名称。 A. 在 CaseList 表上，A 列是名字，B 列是姓氏，列。 C 是 CM。

当上述所有条件都满足时，将下面给出的代码放在Encounter Sheet Module上。为此，请右键单击遇到选项卡 --> 查看代码并将下面给出的代码放入打开的代码窗口中 --> 关闭 VB 编辑器 --> 将您的工作簿保存为启用宏的工作簿。 所以在col中选择了一个CM之后。只要您选择 col 中的相应单元格，就会出现在 Encounter Sheet 上。 B，代码将在该单元格中创建一个数据验证列表，以便您可以从列表中选择用空格分隔的名字和姓氏。一旦你选择了一个项目，名字和姓氏将输入到单元格中，用逗号分隔。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim sws As Worksheet
Dim lr As Long, n As Long, i As Long
Dim x, dict
Application.ScreenUpdating = False
Set sws = Sheets("CaseList")
lr = sws.Cells(Rows.Count, "C").End(xlUp).Row
x = sws.Range("A2:C" & lr).Value
If Target.Column = 2 And Target.Row > 1 Then
    On Error Resume Next
    n = Target.Offset(0, -1).Validation.Type
    If n = 3 Then
        Set dict = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(x, 1)
            If x(i, 3) = Target.Offset(0, -1).Value Then
                dict.Item(x(i, 1) & " " & x(i, 2)) = ""
            End If
        Next i
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                       xlBetween, Formula1:=Join(dict.keys, ",")
        End With
    End If
End If
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Target.Column = 2 And Target.Row > 1 Then
    If Target <> "" Then
        Application.EnableEvents = False
        Target = WorksheetFunction.Substitute(Target.Value, " ", ", ", 1)
        Application.EnableEvents = True
    End If
End If
End Sub