[已解决]二级下拉菜单改为三级

lidayu

下面代码要怎么改为三级下拉（A2一级，A3二级，A4三级）数据来源“sheet1”A列一级，B列二级，C列三级，附图片如下：
二级改为三级.rar (516.61 KB, 下载次数: 6)

2016-3-30 10:01 上传

点击文件名下载附件

2016-3-29 23:03 上传
下载附件 (134.13 KB)

• Private Sub Worksheet_SelectionChange(ByVal Target As Range)
•     If Intersect(Target, [a2:a3]) Is Nothing Then Exit Sub
•     Set d = CreateObject("scripting.dictionary")
•     Arr = Sheets("sheet1").[a1].CurrentRegion
•     For i = 2 To UBound(Arr)
•         x = Arr(i, 1)
•         If InStr(d(x), Arr(i, 2)) = 0 Then d(x) = d(x) & "," & Arr(i, 2)
•     Next
•     If Target.Address = "$A$2" Then k = Join(d.keys, ",") Else k = Mid(d(Range("a2").Value), 2)
•     With Target.Validation
•         .Delete
•         .Add xlValidateList, , , k
•     End With
• End Sub
  

复制代码
谢谢帮助。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-30 10:46

请看附件。

跳转到最佳答案楼层

金樽空对月

提问时最好上个文档附件，别人更容易给你提供满意的答案。

02761752696

http://www.excelpx.com/forum.php ... p;page=1#pid4018416

lidayu

金樽空对月 发表于 2016-3-29 23:37
提问时最好上个文档附件，别人更容易给你提供满意的答案。

金樽空对月 您好，谢谢指教，附件已呈上请您赐教！

lidayu

02761752696 发表于 2016-3-30 08:51
http://www.excelpx.com/forum.php?mod=viewthread&tid=387018&page=1#pid4018416

您好，谢谢指教，附件已呈上请您赐教！

grf1973

请看附件。