将项目添加到基于单元格值的动态下拉列表

Question

这是一个关于是否可以在Excel中执行我想要做的事情的问题。我有一个caselist片，看起来像这样：

而就诊表格，看起来像这样：

在遇到表，我想打一个下拉列表只包含分配给特定案例管理员的人员的姓名。因此，如果我在CM列中输入SH，则只有Case列表中“分配的CM”为SH的情况才会填充下拉菜单。

Excel中可以这样做吗？感谢您的帮助。

Answer 1

您可以尝试下面给出的代码。 该代码假定您在工作簿中有两张名为“Encounter”和“CaseList”的工作表。两张表格的标题都在第1行。在Encounter表中，列A包含CM（一个下拉选择CM），列B将有一个由代码插入的从属下拉列表来选择名称，具体取决于列中选定的CM。 A.在CaseList表中，列A是名，列B是姓和列。 C是CM。

当上面提到的所有条件都满足时，将下面的代码放在Encounter Sheet Module中。为此，请右键单击Encounter Tab - > View Code并将下面给出的代码放到打开的代码窗口中 - >关闭VB编辑器 - >将工作簿保存为启用宏的工作簿。 所以在选择一个CM在col。在您选择列中相应的单元格后，立即在“相遇表”上找到答案。 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