多级菜单（数据有效性）终极方案【VBA】

YZC51

山菊花 发表于 2019-12-3 07:25
参考实例：
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1510882&pid=10166159

学习老师的优秀作品。学生上交作业，烦请老师斧正。谢谢老师！
下拉与级联混合菜单.zip (97.24 KB, 下载次数: 289)

2019-12-3 14:10 上传

点击文件名下载附件

blackttea1

谢谢老师分享！！！

蓝桥玄霜

IVYQQQQQ 发表于 2019-12-3 09:48
在版主面前班门弄斧一下，提个小建议，我现在也一直用多级菜单的，我的做法多了如下内容：
1、在输入当 ...

可以加几句代码：清除同一行后面的数据

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim sj(), nL%, cTxt$, nRow%, Arr(), ds As Object
   
3.     Set ds = CreateObject("Scripting.Dictionary")
   
4.    
   
5.     If Target.Row = 1 Or Target.Column > 4 Or Target.CountLarge > 1 Then Exit Sub
   
6.     nL = Target.Column
   
7.     Select Case nL
   
8.         Case 1
   
9.             Target.Offset(0, 1).Resize(1, 3).ClearContents
   
10.         Case 2
    
11.             Target.Offset(0, 1).Resize(1, 2).ClearContents
    
12.         Case 3
    
13.             Target.Offset(0, 1).ClearContents
    
14.     End Select
    
15.     sj = Range("a" & Target.Row).Resize(1, 3).Value
    
16.     With Sheets("基础")
    
17.         nRow = .Cells(999, nL).End(xlUp).Row
    
18.         Arr = .Range("a1").Resize(nRow, nL).Value
    
19.     End With
    
20.     For i = 2 To nRow
    
21.         For j = 1 To nL - 1
    
22.             If Arr(i, j) <> sj(1, j) Then Exit For
    
23.         Next
    
24.         If j = nL And Not ds.exists(Arr(i, nL)) Then
    
25.             ds(Arr(i, nL)) = ""
    
26.             cTxt = cTxt & "," & Arr(i, nL)
    
27.         End If
    
28.     Next
    
29.     With Target.Validation
    
30.         .Delete
    
31.         If cTxt <> "" Then .Add 3, 1, 1, Mid(cTxt, 2)
    
32.     End With
    
33.    
    
34. End Sub
    

复制代码

中华美德

山菊花 发表于 2019-12-3 12:44
这些做法都很好，向你学习！

VBA跨表取3列数据复制到另外一个工作表
http://club.excelhome.net/thread-1510755-2-1.html

山菊花

YZC51 发表于 2019-12-3 14:10
学习老师的优秀作品。学生上交作业，烦请老师斧正。谢谢老师！

做得很好，向你学习。

YZC51

山菊花 发表于 2019-12-3 17:42
做得很好，向你学习。

谢谢老师鼓励！还烦请老师多多指教！

佛衫丶黄非红

不错，学习 谢谢

bobaby88

楼主，这个给我工作中解决了实际问题，特别感谢，现在有个问题是如果我想在前面加上三列或更多列，咱这个代码又如何改写了？

山菊花

bobaby88 发表于 2019-12-4 08:49
楼主，这个给我工作中解决了实际问题，特别感谢，现在有个问题是如果我想在前面加上三列或更多列，咱这个代 ...

请参考7楼链接。

bobaby88

山菊花 发表于 2019-12-4 08:53
请参考7楼链接。

楼主，小妹是VBA小白一枚，尚未看懂啊，请赐教啊！楼主这个多级菜单着实解决了我实际问题，就是想在前面再加三列或更多列，因为有些要手工输入一些东西！