vba实现excel二级联动多选功能

要求

二级菜单需要根据一级菜单的不同变换内容

二级菜单为多选框，选择后，以逗号分隔显示在单元格内

实现

先上效果图，如下图图一所示，这里面是excel2013版本

图一效果图

数据源放在了sheet2里面,数据源如下图二所示。这里，使用第一行为第一级即H列的数据源【H列加数据验证为序列，源为sheet2的第一列，度娘有很详细的步骤】；I列根据H列的不同，加载对应列为多选的选项。

图二数据源

在编写代码的时候，一定要记得先加控件，步骤图如下图三所示，图四是控件的属性图，另外，请先确定启用了宏和开发工具【度娘有详细教导】。控件名字为ListBox1，放在I列。右键sheet1--查看代码---在编辑器里面针对它进行了一系列编码，这里也附上了编码，代码是我拼凑过来的，我知道不好看，但是好在实现了，，，，，祝好吧。

图三添加控件

图四控件属性

小结

　　老大是想让我一天实现，但是，臣无能啊~第一天都在看二级联动菜单，发现不需要vba啊，度娘说数据验证就能实现了，第二天反应过来了，需要的是多选框，期间调试代码的时候一脸懵逼，就说我控件未定义，后来，老大来了，一脸黑线的帮我在界面拖出个控件，，，，，我控件都没有，编了一堆代码有何用，，，，，，

Option Explicit
    Dim t As String
    Dim Reload As Boolean
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveCell.Value = ListBox1.Value
    Me.ListBox1.Clear
    Me.ListBox1.Visible = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    Dim j As Integer
    Dim Y As Integer
    Dim Z As Integer
    Dim arr1 As Variant, arr2 As Variant
    Dim myStr As String
    Dim columName As String
    Dim X As String
    Me.ListBox1.Clear

    
    If Target.Count = 1 Then '单击一个单元格有效，多选无效

        With Me.ListBox1
             If Target.Column = 11 And Target.Row > 2 Then
                If Cells(Target.Row, Target.Column - 1) <> "" Then '上级没有数据，不显示多选框
              columName = Cells(Target.Row, Target.Column - 1)
              For Y = 1 To 100
              If Sheet2.Cells(1, Y) = columName Then '根据列名得到列号A、B之类的
                 Z = Y
                 If Y > 26 Then
                 X = Mid(Cells(1, Y).Address, 2, 2) '这是处理AA、AB，即26列以后的情况
                 Else
                 X = Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Y, 1)
                 End If
              End If
              Next
              [B5] = X '这是当时用来查看结果的，然后忘记删掉了，，，，，，bless
              With Sheet2 '加载多选项
                arr1 = .Range(X & "2:" & X & .Range(X & "65535").End(xlUp).Row)
                If .Range(X & "65535").End(xlUp).Row <> 2 Then
                For j = 1 To .Range(X & "65535").End(xlUp).Row - 1
                  
                    Me.ListBox1.AddItem arr1(j, 1)
                   
                Next j
                Else
                    Me.ListBox1.AddItem Sheet2.Cells(2, Z)
                End If
              End With
                t = ActiveCell.Value
                Reload = True
                For i = 0 To .ListCount - 1
                     If InStr(t, .List(i)) Then
                        .Selected(i) = True
                     Else
                        .Selected(i) = False
                     End If
                Next
                Reload = False
                .Top = ActiveCell.Top + ActiveCell.Height
                .Left = ActiveCell.Left
                .Width = ActiveCell.Width
                .Visible = True
                
                Else
                .Visible = False '监听到非此列时，隐藏复选框
                End If
            Else
            .Visible = False
            End If
            t = ""
        End With
        
    End If
End Sub
Private Sub ListBox1_Change()
    Dim i As Integer
    Dim flag As Boolean
    flag = False
    If Reload Then Exit Sub
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
        t = t & "," & Me.ListBox1.List(i)
        flag = True
        End If
    Next
    If flag = False Then
        t = ""
    End If
    ActiveCell.Value = ""
    ActiveCell = Mid(t, 2)
    t = ""
End Sub