大家好，今日我们继续讲解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
联系客服
