vba实现excel二级联动多选功能 - __馋猫

时间:2024-02-24 18:29:02

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

要求

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

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

实现

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

图一效果图

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

图二数据源

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

 

图三添加控件

图四控件属性

 

小结

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

 1 Option Explicit
 2     Dim t As String
 3     Dim Reload As Boolean
 4 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 5     ActiveCell.Value = ListBox1.Value
 6     Me.ListBox1.Clear
 7     Me.ListBox1.Visible = False
 8 End Sub
 9 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
10     Dim i As Integer
11     Dim j As Integer
12     Dim Y As Integer
13     Dim Z As Integer
14     Dim arr1 As Variant, arr2 As Variant
15     Dim myStr As String
16     Dim columName As String
17     Dim X As String
18     Me.ListBox1.Clear
19 
20     
21     If Target.Count = 1 Then \'单击一个单元格有效,多选无效
22 
23         With Me.ListBox1
24              If Target.Column = 11 And Target.Row > 2 Then
25                 If Cells(Target.Row, Target.Column - 1) <> "" Then \'上级没有数据,不显示多选框
26               columName = Cells(Target.Row, Target.Column - 1)
27               For Y = 1 To 100
28               If Sheet2.Cells(1, Y) = columName Then \'根据列名得到列号A、B之类的
29                  Z = Y
30                  If Y > 26 Then
31                  X = Mid(Cells(1, Y).Address, 2, 2) \'这是处理AA、AB,即26列以后的情况
32                  Else
33                  X = Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Y, 1)
34                  End If
35               End If
36               Next
37               [B5] = X \'这是当时用来查看结果的,然后忘记删掉了,,,,,,bless
38               With Sheet2 \'加载多选项
39                 arr1 = .Range(X & "2:" & X & .Range(X & "65535").End(xlUp).Row)
40                 If .Range(X & "65535").End(xlUp).Row <> 2 Then
41                 For j = 1 To .Range(X & "65535").End(xlUp).Row - 1
42                   
43                     Me.ListBox1.AddItem arr1(j, 1)
44                    
45                 Next j
46                 Else
47                     Me.ListBox1.AddItem Sheet2.Cells(2, Z)
48                 End If
49               End With
50                 t = ActiveCell.Value
51                 Reload = True
52                 For i = 0 To .ListCount - 1
53                      If InStr(t, .List(i)) Then
54                         .Selected(i) = True
55                      Else
56                         .Selected(i) = False
57                      End If
58                 Next
59                 Reload = False
60                 .Top = ActiveCell.Top + ActiveCell.Height
61                 .Left = ActiveCell.Left
62                 .Width = ActiveCell.Width
63                 .Visible = True
64                 
65                 Else
66                 .Visible = False \'监听到非此列时,隐藏复选框
67                 End If
68             Else
69             .Visible = False
70             End If
71             t = ""
72         End With
73         
74     End If
75 End Sub
76 Private Sub ListBox1_Change()
77     Dim i As Integer
78     Dim flag As Boolean
79     flag = False
80     If Reload Then Exit Sub
81     For i = 0 To Me.ListBox1.ListCount - 1
82         If Me.ListBox1.Selected(i) = True Then
83         t = t & "," & Me.ListBox1.List(i)
84         flag = True
85         End If
86     Next
87     If flag = False Then
88         t = ""
89     End If
90     ActiveCell.Value = ""
91     ActiveCell = Mid(t, 2)
92     t = ""
93 End Sub
代码

 

posted on 2017-01-19 11:37  __馋猫  阅读(3485)  评论(0编辑  收藏  举报