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

Question

这是一个关于是否有可能在excel中做我想做的事情的问题。我有一个如下所示的案例表：

一个看起来像这样的遭遇形式：

在邂逅表上，我想制作一个下拉列表，其中只包含分配给特定案例管理员的人员姓名。因此，如果我在CM列中输入SH，那么只有来自Caselist表单中'Assigned CM'为SH的那些情况才会填充下拉菜单。

这可以在Excel中执行吗？谢谢你的帮助。

Answer 1

您可以尝试下面给出的代码。 该代码假定您在工作簿中有两张名为＆＃34; Encounter＆＃34;和＆＃34; CaseList＆＃34;。两张纸上的标题都在第1行。在“遭遇表”中，列A包含CM（下拉选择CM），列B将具有由代码插入的从属下拉列表，以根据列中选定的CM选择名称。 A.在CaseList Sheet上，Col.A是名字，Col.B是姓氏和col。 C是CM。

如果满足上述所有条件，请将下面给出的代码放在Encounter Sheet Module上。为此，请右键单击Encounter Tab - ＆gt;查看代码并将下面给出的代码放入打开的代码窗口 - ＆gt;关闭VB编辑器 - ＆gt;将工作簿另存为启用宏的工作簿。 所以在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