如何用vba制作二级下拉数据有效性的下拉菜单？

作者：绿色风分类：时间：2022-08-17 浏览：93

楼主 wcymiss	Q：如何用vba制作二级下拉数据有效性的下拉菜单？如图数据： A：vba代码如下： Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count = 1 And Target.Row > 2 Then Dim d, arr, i%, j&, ar, t%, st$ Set d = CreateObject("scripting.dictionary") With Worksheets("供应商") t = .Cells(2, .Columns.Count).End(1).Column - 1 '取得有效数据的最大列号 arr = .Range("b2").Resize(1, t).Value '将一级菜单内容赋值给数组arr For i = 1 To t d(arr(1, i)) = "" ''装入父字典 Set d(arr(1, i)) = New Dictionary '定义子字典 ar = .Range(.Cells(3, i + 1), .Cells(.Rows.Count, i + 1)).Value '二级菜单内容赋值给数组 For j = 1 To UBound(ar, 1) If Len(Trim(ar(j, 1))) Then d(arr(1, i))(ar(j, 1)) = "" '二级菜单内容装入子字典 End If Next j Next i End With Select Case Target.Column Case 3 With Target.Validation '设置一级数据有效性 .Delete '删除之前的有效性 .Add Type:=xlValidateList, Formula1:=Join(d.Keys, ",") '将父字典的key值作为一级有效性序列 End With Case 5, 7, 9, 11, 13 st = Cells(Target.Row, 3).Value '取当前一级菜单内容 If d.Exists(st) Then '如果存在此菜单，则 With Target.Validation '设置二级数据有效性 .Delete '删除之前的有效性 .Add Type:=xlValidateList, Formula1:=Join(d(st).Keys, ",") '将子字典的key值作为二级有效性序列 End With End If Case Else End Select End If End Sub vba之二级数据有效性下来菜单.rar
2楼 jl128	谢谢
3楼 lzqlaj	这个菜单很灵活，实用，谢谢分享。
4楼 KenshinTai
5楼 /dy/mn__阿哲
6楼 star591	不能实现自动切换，还需要选择一下，怎么实现更换报价项目自动显示对应的供应商的第一项
7楼 hacker85	如何去除有效出错警告

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表