Microsoft Excel：基于依赖关系的下拉列表

Question

我想创建一个 Excel 表，其中数据应输入到 Row-* - Column-A。

在将数据输入 Row-N::Column-A 后，我想将输入的数据与从 Column-B 的下拉列表中选择的条目相关联。

现在，Column-B 列表中的每个项目实际上都有一个专用列表。如果我在 Column-B 中选择了 Item-X，那么我应该可以在 Column-C 中从专门用于 Item-X 的列表中选择一个项目。

这是怎么做的？

Answer 1

下面的代码将帮助您通过简单地将数据粘贴到源列中来创建依赖列表。为了简单起见，我们将上面的列表复制并粘贴到 Excel 工作表的 A 列和 B 列中，例如 Sheet1。但是在我们这样做之前，我们必须将以下代码粘贴到工作表代码区域中。通过在主工作表中按 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，您可以获取更多详情。