利用数组和字典，实现两级下拉菜单的录入方式

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

myarr = Range("a2:b" & [b65536].End(xlUp).Row) '将菜单装入数组

If UBound(myarr)

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

.AddType:=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

.AddType:=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 ExitSub

myarr = Range("a2:b" & [b65536].End(xlUp).Row) '将菜单装入数组

If UBound(myarr)

上述代码给出了三个屏蔽的条件，其一是在选择区域的单元格不是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

.AddType:=xlValidateList, AlertStyle:=xlValidAlertStop, _

Operator:=xlBetween,Formula1:=Join(myDic.keys, ",")

End With

Target.Offset(0, 1) =""

上述代码完成了一级菜单的加载，首先我们在数组中将菜单值写入字典中的键，然后在通过Target.Validation的属性加载键。

5 ElseIf Target.Column = 4And 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

.AddType:=xlValidateList, AlertStyle:=xlValidAlertStop, _

Operator:=xlBetween,Formula1:=Join(mytwoDic.keys, ",")

End With

上述代码中我们要先判断是否要实现二级菜单，如果要实现，那么将菜单值写入键中，然后实现。

下面看代码的运行：

一级菜单的实现：

二级菜单的实现：

今日内容回向：

1两级菜单是如何利用数组来实现的？

2在代码中已经屏蔽了很多条件，为什么在开始还要有On ErrorResume Next