Excel任意多级联动菜单不再是个难题！
Public d As Object
'功能：选择改变事件，实时动态建立多级菜单'公众号：Excel办公实战'日期：20210611'----------------------------------Private Sub Worksheet_SelectionChange(ByVal Target As Range) totalcol = getData If Target.CountLarge > 1 Then End Target.Offset(, 1).Resize(1, 10).Clear sc = Target.Column If sc > totalcol Then End If sc = 1 Then s = Filter(d.Keys, ">2", False) With Target.Validation .Delete .Add 3, 1, 1, Replace(Join(s, ","), ">1", "") End With Else skey = "" For n = sc - 1 To 1 Step -1 skey = skey & Target.Offset(, -n) & ">" & sc - n Next s = d(skey) leftRng = Cells(Target.Row, 1).Resize(1, sc - 1) If Application.CountA(leftRng) = sc - 1 Then With Target.Validation .Delete If Len(s) > 0 Then .Add 3, 1, 1, Mid(s, 2) End If End With Else Target.Validation.Delete End If End IfEnd Sub
'功能：数据多级装入字典'日期：20210611'----------------------------------Public Function getData() Set d = CreateObject("scripting.dictionary") Dim lRow As Long, arr Const col As Long = 4 With Sheets("基础") lRow = .Cells(Rows.Count, 1).End(3).Row arr = .Range("A1").Resize(lRow, col).Value End With For i = 2 To UBound(arr) skey = "" For j = 1 To UBound(arr, 2) - 1 skey = "" For n = 1 To j skey = skey & arr(i, n) & ">" & n Next If InStr(d(skey) & ",", "," & arr(i, j + 1) & ",") = 0 Then d(skey) = d(skey) & "," & arr(i, j + 1) End If Next Next getData = UBound(arr, 2)End Function
有朋友扫之前的码可能发现了，由于星球试运营没有达标，后期无法在加入新的伙伴。所以我们重新触发，用心付出！白嫖或许使你快乐，但是有伙伴一起交流、有问题能及时得到答疑解惑，可能让你的更有学习的动力、工作更加顺利！
如果公众号的文章你80%都可以自己搞定，那么也可以联系小编免费加入，做做学长学姐，未来还有小礼物送额！
赞 (0)