|
一级菜单和二级菜单1的下拉选项的代码老师已经帮忙写好了,现在需要在让代码增加两项,让二级菜单2和二级菜单3都具有下拉选项,该选项均与一级菜单对应,这是一个一级菜单和多个二级菜单,并非四级菜单,拜谢!
详见附件
- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Count > 1 Then Exit Sub
- If Intersect(Target, [b2:b10]) Is Nothing Then Exit Sub
- Target.Offset(, 1).Resize(, 3).Validation.Delete
- Target.Offset(, 1).Resize(, 3).ClearContents
- End Sub
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim TheList As String, i&
- If Target.Count > 1 Then Exit Sub
- If Intersect(Target, [b2:e10]) Is Nothing Then Exit Sub
- Set d = CreateObject("scripting.dictionary")
- arr = Sheet2.Range("c2:f" & Sheet2.[c65536].End(3).Row)
- For i = 1 To UBound(arr)
- x = arr(i, 1)
- If Len(x) Then
- If InStr(d(x) & ",", "," & arr(i, 2) & ",") = 0 Then d(x) = d(x) & "," & arr(i, Target.Column - 1)
- End If
- Next
-
- TheList = IIf(Target.Column = 2, Join(d.keys, ","), Mid(d(Cells(Target.Row, 2).Value), 2))
- With Target.Validation
- .Delete
- .Add xlValidateList, , , TheList
- End With
- End Sub
复制代码
|
|