Question

EXCEL中怎么实现多级联动的下拉菜单

Answer 1

通过vba来实现

SelectionChange 及change事件结合处理

1、级联原始数据

可以继续增加更多列的级联数据，不影响本程序使用

2、实现多级联动的表格

选择A列，然后逐级选择，就会增加选项序列，如果选项为空，该行后面的表格内容清空

3、alt+f11打开vbe，在“级联选项”表对应区域增加代码

4、代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
    Application.EnableEvents = False '关闭事件
    Target.Offset(0, 1).Resize(1, Columns.Count - Target.Column).Clear '，清空该单元格之后的数据
    If Target.Value <> "" Then

        arr = Sheets(2).UsedRange
        c = Target.Column
        If c < UBound(arr, 2) Then '使用字典，在当前列的下一列同行单元格增加数据有效性
            Set d = CreateObject("scripting.dictionary")
            For j = 2 To UBound(arr) '读取符合要求的选项，字典去重
                If arr(j, c) = Target.Value Then
                    d(arr(j, c + 1)) = ""
                End If
            Next j
            If d.Count > 0 Then '增加数据有效性序列
                With Target.Offset(0, 1).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=Join(d.keys, ",") 'Mid(str1, 2)
                End With
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) '给第一列菜单添加选项
    If Target.Count <> 1 Then Exit Sub
    If Target.Column = 1 And Target.Row <> 1 Then
        If Target.Value = "" Then
            Set d = CreateObject("scripting.dictionary")
            arr = Sheets(2).UsedRange
            For j = 2 To UBound(arr) '将第一列对应的选项去重
                d(arr(j, 1)) = ""
            Next j
            With Target.Validation '添加数据有效性
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:=Join(d.keys, ",")
        
            End With
        End If
    End If
End Sub

5、实现效果