|
大家好，今日我们继续讲解VBA数组与字典解决方案，今日讲解第48讲：利用数组和字典，实现两级下拉菜单的录入方式。我们在EXCEL的录入时经常要校验数据，利用下拉菜单录入是保证录入规范的一个有效手段。如何在VBA中实现下拉菜单的方式呢？我今天就数组和字典的内容和大家讲解一下。 实例，如下的数据，我要在一级菜单和二级菜单中分别实现下面的数据，以方便在C,D列的录入，也就是说，在C列点击后会出现一级下拉菜单，菜单内容是A列的内容，在D列点击的时候，会根据C列的内容出现相应的二级菜单，内容是B列的内容，怎么实现呢？看视很复杂，其实并不难，因为我们有了数组和字典。看下面的代码： Private Sub Worksheet_SelectionChange(ByVal Target As Range) '第48讲 利用字典与数组建立二级下拉菜单 On Error Resume Next '要实现自在C列和D列的点击效果 If Target.Count <> 1 Then Exit Sub If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub myarr = Range('a2:b' & [b65536].End(xlUp).Row) '将菜单装入数组 If UBound(myarr) < 3 Then Exit Sub Set myDic = CreateObject('Scripting.Dictionary') '建立一级菜单字典 Set mytwoDic = CreateObject('Scripting.Dictionary') '建立二级菜单字典 If Target.Column = 3 Then For i = 1 To UBound(myarr) If myarr(i, 1) <> '' Then myDic(myarr(i, 1)) = '' '将菜单值写入字典的键 Next '一级菜单实现 With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(myDic.keys, ',') End With Target.Offset(0, 1) = '' ElseIf Target.Column = 4 And Target.Offset(0, -1) <> '' Then For i = 1 To UBound(myarr) T = myarr(i, 1) If T <> '' Then T1 = T If T = '' Then T = T1 If T = Target.Offset(0, -1) Then mytwoDic(myarr(i, 2)) = myarr(i, 2) '将菜单值写入键 End If Next '二级菜单实现 With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(mytwoDic.keys, ',') End With End If Set myDic = Nothing Set mytwoDic = Nothing End Sub 代码截图： 代码解析： 1 上述代码实现了在C,D列点击鼠标时，下拉菜单的动态响应，其中在C列点击响应的是一级菜单，在D列点击实现的是二级菜单。 2 '要实现自在C列和D列的点击效果 If Target.Count <> 1 Then Exit Sub If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub myarr = Range('a2:b' & [b65536].End(xlUp).Row) '将菜单装入数组 If UBound(myarr) < 3 Then Exit Sub 上述代码给出了三个屏蔽的条件，其一是在选择区域的单元格不是1的时候，其二是行数和列数不等于4和3的时候，其三是给出的UBound(myarr)小于3的时候，都是好理解的，我们不再过多的解释。 3 Set myDic = CreateObject('Scripting.Dictionary') '建立一级菜单字典 Set mytwoDic = CreateObject('Scripting.Dictionary') '建立二级菜单字典 上述代码用两个字典分别用作两个菜单的装载工具，这里用的键。 4 If Target.Column = 3 Then For i = 1 To UBound(myarr) If myarr(i, 1) <> '' Then myDic(myarr(i, 1)) = '' '将菜单值写入字典的键 Next '一级菜单实现 With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(myDic.keys, ',') End With Target.Offset(0, 1) = '' 上述代码完成了一级菜单的加载，首先我们在数组中将菜单值写入字典中的键，然后在通过Target.Validation的属性加载键。 5 ElseIf Target.Column = 4 And Target.Offset(0, -1) <> '' Then For i = 1 To UBound(myarr) T = myarr(i, 1) If T <> '' Then T1 = T If T = '' Then T = T1 If T = Target.Offset(0, -1) Then mytwoDic(myarr(i, 2)) = myarr(i, 2) '将菜单值写入键 End If Next '二级菜单实现 With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(mytwoDic.keys, ',') End With 上述代码中我们要先判断是否要实现二级菜单，如果要实现，那么将菜单值写入键中，然后实现。 下面看代码的运行： 一级菜单的实现： 二级菜单的实现： 今日内容回向： 1 两级菜单是如何利用数组来实现的？ 2 在代码中已经屏蔽了很多条件，为什么在开始还要有On Error Resume Next |
|
|
