將項目添加到基於單元格值的動態下拉列表

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