VBA新手学习笔记之：二级下拉菜单（字典嵌套法）
我的图书馆
VBA新手学习笔记之：二级下拉菜单（字典嵌套法）
如下效果图：今天这个效果所涉及的新增知识点有：1.& 模块级变量的定义2.& 事件程序3.& 字典嵌套4.& Join函数下面我们逐一来解读下这四个知识点：1.先看看什么是事件& & & &之前我们执行Excel程序都需要手动画一个按钮，然后将对应的过程指定给这个按钮，当我们需要程序运行的时候，就发送一个命令（点一下按钮）给这个程序，程序接收命令后，会按照程序的逻辑进行运行。& & & &而事件程序是不需要手工指定按钮，而是当我们在操作Excel的时候有些动作会自动被ExcelVBA所识别，VBA内部已经自行内置了有关此事件的过程名，我们在对应的过程中写需要执行操作的代码，当Excel的某个动作发生的时候，会自动触发执行所写的程序。这个案例所用到的事件程序有两个：第一：单元格选区发生变化的时候 ：当需要填写省份的那一列的单元格选区发生变化时，需要添加去重后的省份的下拉菜单操作方法：对准需要达到效果的工作表名的位置右键——查看代码——进入工作表的代码编辑区——选择worksheet——会自动弹出（单元格选区发生变化时要执行的过程）——在该过程中写所需要的代码即可Private SubWorksheet_SelectionChange(ByVal Target As Range)End Sub第二：单元格的值发生变化的时候：当省份填写完毕后，则需要将对应省份的城市添加到城市单元格的下拉菜单，如果省份单元格没有填、则城市下拉菜单跟着消失。操作方法：前面的操作与第一点都是一样的，调出代码窗口后——选择worksheet——在事件下拉框中选择Change事件——会自动生成（单元格值发生变化时要执行的过程）Private Sub Worksheet_Change(ByValTarget As Range)End Sub2.因为今天的两个程序中都需要使用同一个字典来做数据有效性的下拉菜单，所以用了一个字典对象的模块级变量dicSF,所谓模块级变量即在同一个模块内所有程序都能使用的变量；这里涉及到变量的作用域的问题，大家可以百度搜索下什么叫变量的作用域。3.字典嵌套的运用，因为我们要通过不同的省份分别对应找到其对应的城市，显然这是一个字典无法完成的事情，因为我们有很多个省份，多个省份下又又多个城市，所以我们在省份字典dicSF中每存入一个省份，那么就将这个省份作为一个新的字典的名称再创建一个字典，在这个字典下将城市再存入省份这个字典的Keys里字典嵌套大家不要想得太复杂，我们只要将省份字典的keys看成是你定义的一个新的字典名称，就很容易理解了就拿案例来说：字典嵌套的核心代码见下For i = 2 To UBound(arr)& &If Not dicSF.Exists(arr(i,1)) Then& & & '创建对应省份的字典& & & &Set dicSF(arr(i, 1)) =CreateObject('scripting.dictionary')& &End If& &'在该省份的字典内添加所属城市& dicSF(arr(i,1))(arr(i, 2)) = ''Next i代码解读：如果字典dicSF中没有对应的省份，比如现在I循环到2，那么省份就是云南，第一个循环，云南还没有存到dicSF中，那么 NotdicSF.Exists(arr(i, 1))的结果就是True，就执行下面的这个创建字典的操作Set dicSF(arr(i, 1)) =CreateObject('scripting.dictionary')，我们把代码分解出来，dicSF是我们定义的一个字典名称；同理：Set dicSF(arr(i, 1))也可以看成我们定义的一个字典的名称，如果i=2,那么这里的dicSF(arr(i, 1))实际上就是dicSF（云南），那么在这个字典里添加对应城市的代码 dicSF(arr(i, 1))(arr(i, 2)) =''就可以看成dicSF（云南）（思茅市）=“”，也就是说“思茅市”是dicSF（云南）的第一个key。循环完之后，所有的省份就都创建了一个字典并将其下属的城市都存进其keys中了。4.join函数是将一个数组以给定的分割符组合成一个长字符串，数据有效性种序列来源值的格式要求将每个城市以逗号分割开，我们知道，字典的keys和Items都是一个以0开始的一维数组，在选择来源的时候我们不能直接将数组给它，所以就用到Join函数来连接数组的每个元素了。With Target.Validation& & & & .Delete& & & & .AddType:=xlValidateList,AlertStyle:=xlValidAlertStop,Operator:=_& & & & & & & & & & & & & xlBetween, Formula1:=Join(dicSF.Keys, ',')End With最后附上两段完整的代码：Option Explicit '要求变量声明Dim dicSF As Object &'定义一个模块级变量用来存去重之后的省份'单元格的值发生变化时要做的事Private Sub Worksheet_Change(ByVal Target As Range)& & Dim strSF As String& & With Target& & & & If .Column && 6 Then Exit Sub& & & & If .Count && 1 Then Exit Sub& & & & strSF = .Value& & & &&& & & & '下面是通过'数据有效性'录制宏得到的代码& & & & With .Offset(0, 1).Validation& & & & & & .Delete& & & & & & If strSF && '' Then& & & & & & & & .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _& & & & & & & & & & & & & & & & & &xlBetween, Formula1:=Join(dicSF(strSF).Keys, ',')& & & & & & Else& & & & & & & & .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, _& & & & & & & & & & & & & & & & & Operator:=xlBetween& & & & & & End If& & & & End With& & End WithEnd Sub'单元格选区发生变化时要做的事Private Sub Worksheet_SelectionChange(ByVal Target As Range)& & Dim arr, i As Integer& & If Target.Column && 6 Then Exit Sub& & If Target.Row & 1 Then& & & & '清空选中单元格对应城市的单元格的内容& & & & Target.Offset(0, 1).Value = ''& & & & Set dicSF = CreateObject('scripting.dictionary')& & & & arr = Range('A1').CurrentRegion.Value& & & & For i = 2 To UBound(arr)& & & & & & '如果字典里没有保存该省份& & & & & & If Not dicSF.Exists(arr(i, 1)) Then& & & & & & & & '创建对应省份的字典& & & & & & & & Set dicSF(arr(i, 1)) = CreateObject('scripting.dictionary')& & & & & & End If& & & & & & '在该省份的字典内添加所属城市& & & & & & dicSF(arr(i, 1))(arr(i, 2)) = ''& & & & Next i& & & & '添加数据有效性& & & & With Target.Validation& & & & & & .Delete& & & & & & .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _& & & & & & xlBetween, Formula1:=Join(dicSF.Keys, ',')& & & & End With& & End IfEnd Sub好了，今天分享完毕，各位早点休息。
喜欢该文的人也喜欢With wk.ActiveSheet 2
Cells.Select 4
Cells.EntireColumn.AutoFit 5
Cells.EntireRow.AutoFit 6
Selection.Locked = False 7
Selection.FormulaHidden = False 8
Columns("A:F").Select 9
Selection.Locked = True10
Selection.FormulaHidden = False11
DrawingObjects:=False, Contents:=True, Scenarios:=False12
使用VBA对EXCEL工作表进行保护后,数据有效性 的下拉菜单无法使用
代码如上,对A:F列进行了保护,G列的数据有效性的下拉菜单却无法使用了.请高手帮忙解决一下.
　　　　　　　　　　　　　　　　　　　　　　　　　　　　为感!
提问于： 18:28
分享您的问题
这个，你不用VBA也能做，所以你应该先问精通VBA的业务工作人员们。
对于数据表保护，有下列限制：
工作表保护相关参考 & 保护下的整体情况(只要保护，下面的就有效) 1、若单元格被"锁定"，则不能编辑单元格内容。 2、若某个操作被禁止，则用API 也不能绕过保护。 3、不能解锁任何单元格。 4、不能插入单元格，行列另有说明 。 5、不能合并单元格。 6、不能插入名称 。 7、不能创建自动筛选（创建与使用还是有区别的）。 8、不能使用&分类汇总&，&数据有效性&，&分列&，&组及分极显示&。 9、不能建立数据透视表 。 10、不能导入数据 。
不知道你要实现什么功能，看来你得换个思路了，问问那些精通Excel，只用菜单命令就能完成复杂任务的业务人员，他们比你更在行。
顺便给你截了个图，就是点击&保护工作表&后的设置，你可以看到有个允许的功能列表：
收获园豆：100
|园豆：44916
清除回答草稿
&&&您需要以后才能回答，未注册用户请先。查看: 617|回复: 0
Excel工作表保护时，用VBA成功运行组合功能后，排序、筛选和下拉菜单功却不能用了
阅读权限10
在线时间 小时
第一步 对Excel作保护工作表时， 勾选了“选定未锁定的单元格”、“排序”、“使用自动筛选”、“编辑对象”和“编辑方案” 查看以下图片第二步 由于工作表使用了组功能， 保护工作表后不能打开组或重新组合组，所以录入下列VBA程序，保障组功能依然运行正常。
& && && && &Private Sub Workbook_Open()& && && && && && &&&Worksheets(&Outbound Daily Report&).ProtectPassword:=&123&, userinterfaceonly:=True& && && && && && &&&Worksheets(&Outbound Daily Report&).EnableOutlining = True& && && && &End Sub第三步&&调试工作表，保护工作表功能、组功能、筛选功能、排序功能、数据有效性下拉菜单功能一切均可正常使用。第四步&&保存工作表，关闭工作表，无任何异常提示！第五步&&重新打开工作表，无异常提示，保护工作表功能生效，组功能也正常运行，但发现单元格排序、帅选和下拉菜单失效，鼠标点击无反应。见图第六步&&撤销工作表保护，发现第一步对“排序”、“使用自动筛选”、“编辑对象”和“编辑方案”的勾选 自动取消了，才造成了第五步的异常现象！ 见图第七步&&于是重复勾选上它们，保护工作表后，如第三步一样均可正常使用。关闭表后重新打开，第五步和第六步的异常现象又重复发生了。& && && && & 依照猜想，应该是录入的VBA 程序对勾选项 “排序”、“使用自动筛选”、“编辑对象”和“编辑方案” 作了取消指令。& && && && & 跪求Excel高手填补此VBA程序（以上），使其在工作表保护的情况下，组功能、筛选功能、排序功能、数据有效性下拉菜单功均可正常使用。十分感谢谢！！！[img]file:///C:\Documents and Settings\Administrator\Application Data\Tencent\Users\\QQ\WinTemp\RichOle\6LBG5HNCEF@4~QC}6[[%R8K.png[/img]
[img]file:///C:\Documents and Settings\Administrator\Application Data\Tencent\Users\\QQ\WinTemp\RichOle\6LBG5HNCEF@4~QC}6[[%R8K.png[/img]
(16.47 KB, 下载次数: 1)
23:31 上传
(10.04 KB, 下载次数: 1)
23:46 上传
(15.9 KB, 下载次数: 0)
00:00 上传
最新热点 /1
本活动是由微软（中国）有限公司发起，申请通过者可以得到Office 365企业级E3 试用账号，并享有全套Office 365客户端及云端高效、协作办公体验。 机会有限，先到先得！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 1004|回复: 6
如下代码，如何修改下，能点下单元格，就自动打开下拉菜单呢
阅读权限20
在线时间 小时
求大侠看一眼，怎么改这个代码，点单元格时，不用再点小三角，就自动弹出下拉菜单
Sub Macro1()
' Macro1 Macro
& & With Selection.Validation
& && &&&.Delete
& && &&&.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
& && &&&xlBetween, Formula1:=&1,2,3,4&
& && &&&.IgnoreBlank = False
& && &&&.InCellDropdown = True
& && &&&.InputTitle = &&
& && &&&.ErrorTitle = &&
& && &&&.InputMessage = &&
& && &&&.ErrorMessage = &&
& && &&&.IMEMode = xlIMEModeNoControl
& && &&&.ShowInput = True
& && &&&.ShowError = False
& & End With
阅读权限100
在线时间 小时
代码中不看出你的数据有效性是在哪个区域
比如在C列可以这样
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
& & If Target.Column = 3 Then Application.SendKeys &%{down}&
阅读权限20
在线时间 小时
本帖最后由 曹建勇 于
16:21 编辑
代码中不看出你的数据有效性是在哪个区域
比如在C列可以这样
Private Sub Worksheet_SelectionChange(ByV ...
加上这段后，数字键盘就不能锁定了，是个小麻烦，搞不定
能不能不用&&SendKeys
阅读权限100
在线时间 小时
加上这段后，数字键盘就不能锁定了，是个小麻烦，搞不定
能不能不用&&SendKeys
可以的，弃用有效性，改用combobox按件
阅读权限20
在线时间 小时
可以的，弃用有效性，改用combobox按件
能给段代码吗？
阅读权限100
在线时间 小时
能给段代码吗？
不能，原则说发贴不发附件的，我都不喜欢给人写代码，你想一下，给你写个代码，还要给你制作一个附件测试多累你知道吗？
阅读权限20
在线时间 小时
不能，原则说发贴不发附件的，我都不喜欢给人写代码，你想一下，给你写个代码，还要给你制作一个附件测试 ...
有劳大师了
最新热点 /1
本活动是由微软（中国）有限公司发起，申请通过者可以得到Office 365企业级E3 试用账号，并享有全套Office 365客户端及云端高效、协作办公体验。 机会有限，先到先得！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 5047|回复: 17
工作表数据有效性下拉菜单实现输入时逐步提示信息
阅读权限20
在线时间 小时
本帖最后由 醉倾城 于
13:40 编辑
附件总共有5个工作表，其中前三个当中的总帐科目、二级科目、三级科目输入时，下拉菜单能能实现输入时逐步提示信息，因下拉菜单数据较多，一个个选择太浪费时间了。本人不会VBA，希望有人帮忙设计好这个表格，谢谢！{:soso_e183:}
(267.61 KB, 下载次数: 43)
13:39 上传
点击文件名下载附件
阅读权限20
在线时间 小时
{:soso_e149:}有没有人帮忙写一下我这个程序，我网上看了输入时逐步提示信息，但不会改
阅读权限50
在线时间 小时
做是很简单的，但你也不能懒到连源数据对应区域也不告诉我们吧，还要我们自己匹配吗？
阅读权限20
在线时间 小时
& & & & & & & &
还是没有人帮忙吗？坐等求助呀{:soso_e150:}
阅读权限20
在线时间 小时
2013现金与2013银行工作中的总帐科目的数据有效性数据源在数据源表1的A列，定义名称为总帐科目，二级科目是等于总帐科目里的定义名称的,现在主要是想求助其他应收款输入时能够实际提示的，因为客户比较多，其他的都是固定的
阅读权限20
在线时间 小时
大灰狼1976 发表于
做是很简单的，但你也不能懒到连源数据对应区域也不告诉我们吧，还要我们自己匹配吗？
不是我懒呀，是我原先做的比较乱，所以不知道怎么去说。
阅读权限20
在线时间 小时
重新上传了附件，在数据源表1中第一行就是对应的数据源。
11:40 上传
点击文件名下载附件
283.87 KB, 下载次数: 22
阅读权限20
在线时间 小时
大灰狼1976 发表于
做是很简单的，但你也不能懒到连源数据对应区域也不告诉我们吧，还要我们自己匹配吗？
(283.87 KB, 下载次数: 11)
11:42 上传
点击文件名下载附件
我重新上传了附件，你帮忙看一下，能不能帮我做一下呀，麻烦帮忙！谢谢！
阅读权限50
在线时间 小时
这么说吧，“2013现金”工作表的“总帐科目”所对应的源数据是“源数据表1”工作表的哪列数据，
按这个方式把每个工作表所对应的源数据区域告诉我就行了，省得我自己找。
另，说句题外话，“总帐”的“帐”应该写成“账”
阅读权限100
在线时间 小时
你需要把总账科目，一级科目，二级科目都列出来，
比如有10个总账科目，每一个总账科目对应哪些一级科目，每一个一级科目下有哪些二 级科目，
只有知道了这些，才有可能做下面的事情。
最新热点 /1
本活动是由微软（中国）有限公司发起，申请通过者可以得到Office 365企业级E3 试用账号，并享有全套Office 365客户端及云端高效、协作办公体验。 机会有限，先到先得！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师