Microsoft Excel：基於依賴關係的下拉列表

Question

我想創建一個Excel表格，其中數據應輸入到Row- * - Column-A中。

將數據輸入到Row-N :: Column-A時，我想將輸入的數據與從列B中可用的下拉列表中選擇的條目相關聯。

現在，列B列表中的每個項目都有一個專門的列表。如果我在Column-B中選擇了Item-X，我應該可以在Column-C中從專用於Item-X的列表中選擇一個項目。

這是怎麼做的？

Answer 1

以下代碼將幫助您僅通過在源列中粘貼數據來創建相關列表。爲了簡單起見，我們將複製上面的列表並將其粘貼到Excel工作表的A列和B列中，如Sheet1。然而，在我們這樣做之前，我們必須將下面的代碼粘貼在Sheet Code Area中。可以通過按主工作表中的Alt + F11來訪問表單代碼區域。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim i As Long, LastRow As Long, n As Long 
    Dim MyCol As Collection 
    Dim SearchString As String, TempList As String 

    Application.EnableEvents = False 

    On Error GoTo Whoa 

    '~~> Find LastRow in Col A 
    LastRow = Range("A" & Rows.Count).End(xlUp).Row 

    If Not Intersect(Target, Columns(1)) Is Nothing Then 
     Set MyCol = New Collection 

     '~~> Get the data from Col A into a collection 
     For i = 1 To LastRow 
      If Len(Trim(Range("A" & i).Value)) <> 0 Then 
       On Error Resume Next 
       MyCol.Add CStr(Range("A" & i).Value), CStr(Range("A" & i).Value) 
       On Error GoTo 0 
      End If 
     Next i 

     '~~> Create a list for the DV List 
     For n = 1 To MyCol.Count 
      TempList = TempList & "," & MyCol(n) 
     Next 

     TempList = Mid(TempList, 2) 

     Range("D1").ClearContents: Range("D1").Validation.Delete 

     '~~> Create the DV List 
     If Len(Trim(TempList)) <> 0 Then 
      With Range("D1").Validation 
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
       xlBetween, Formula1:=TempList 
       .IgnoreBlank = True 
       .InCellDropdown = True 
       .InputTitle = "" 
       .ErrorTitle = "" 
       .InputMessage = "" 
       .ErrorMessage = "" 
       .ShowInput = True 
       .ShowError = True 
      End With 
     End If 
    '~~> Capturing change in cell D1 
    ElseIf Not Intersect(Target, Range("D1")) Is Nothing Then 
     SearchString = Range("D1").Value 

     TempList = FindRange(Range("A1:A" & LastRow), SearchString) 

     Range("E1").ClearContents: Range("E1").Validation.Delete 

     If Len(Trim(TempList)) <> 0 Then 
      '~~> Create the DV List 
      With Range("E1").Validation 
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
       xlBetween, Formula1:=TempList 
       .IgnoreBlank = True 
       .InCellDropdown = True 
       .InputTitle = "" 
       .ErrorTitle = "" 
       .InputMessage = "" 
       .ErrorMessage = "" 
       .ShowInput = True 
       .ShowError = True 
      End With 
     End If 
    End If 

LetsContinue: 
    Application.EnableEvents = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

'~~> Function required to find the list from Col B 
Function FindRange(FirstRange As Range, StrSearch As String) As String 
    Dim aCell As Range, bCell As Range, oRange As Range 
    Dim ExitLoop As Boolean 
    Dim strTemp As String 

    Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _ 
    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False) 

    ExitLoop = False 

    If Not aCell Is Nothing Then 
     Set bCell = aCell 
     strTemp = strTemp & "," & aCell.Offset(, 1).Value 
     Do While ExitLoop = False 
      Set aCell = FirstRange.FindNext(After:=aCell) 

      If Not aCell Is Nothing Then 
       If aCell.Address = bCell.Address Then Exit Do 
       strTemp = strTemp & "," & aCell.Offset(, 1).Value 
      Else 
       ExitLoop = True 
      End If 
     Loop 
     FindRange = Mid(strTemp, 2) 
    End If 
End Function 

你可以得到更多關於上述here的細節。