暂无图片
暂无图片
暂无图片
暂无图片
暂无图片
首页 / VBA字典之两级下拉菜单

VBA字典之两级下拉菜单

VBA语言専攻 2023-01-07
204
【分享成果，随喜正能量】望尽沧桑，释怀过往。当你珍惜自己的过去，满意自己的现在，乐观自己的未来时，你就站在了生活的最高处。流年笑掷，时光未央，奋力拼搏，未来可期。。
《VBA数组与字典方案》教程（10144533）是我推出的第三套教程，目前已经是第二版修订了。这套教程定位于中级，字典是VBA的精华，我要求学员必学。7.1.3.9教程掌握后，可以解决大多数工作中遇到的实际问题。
这套字典教程共两册，一共八十四讲，今后一段时间会给大家陆续推出修订后的教程内容。今日的内容是：VBA字典之两级下拉菜单

第四十八讲 利用数组和字典，实现两级下拉菜单录入

大家好，今日我们继续讲解VBA数组与字典解决方案，今日讲解第48讲：利用数组和字典，实现两级下拉菜单的录入方式。我们在EXCEL的录入时经常要校验数据，利用下拉菜单录入是保证录入规范的一个有效手段。如何在VBA中实现下拉菜单的方式呢？我今天就数组和字典的内容和大家讲解一下。

1  应用场景的具体分析

实例，如下的数据，我要在一级菜单和二级菜单中分别实现下面的数据，以方便在C,D列的录入，也就是说，在C列点击后会出现一级下拉菜单，菜单内容是A列的内容，在D列点击的时候，会根据C列的内容出现相应的二级菜单，内容是B列的内容，怎么实现呢？看视很复杂，其实并不难，因为我们有了数组和字典。

2  利用数组和字典，实现两级下拉菜单的代码及代码讲解

由于实现的是工作表的事件，我们的代码是写在了Worksheet_SelectionChange的工作表事件中。

看下面的代码：

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



我多年的VBA实践经验，全部浓缩在以下十套教程中，可以联络我V信VBA6337取得教程，成为我的学员：



【分享成果，随喜正能量】不须计较与安排，领取而今现在。抖落岁月的尘埃，以一颗无尘的心，还原生命的本真，一往无前，未来可期。。

vbavba字典vba数组下拉菜单target
文章转载自VBA语言専攻，如果涉嫌侵权，请发送邮件至：contact@modb.pro进行举报，并提供相关证据，一经查实，墨天轮将立刻删除相关内容。

评论