Excel单元格中怎么才能设置多级下拉菜单多选功能

XUN8176

请教楼主，Excel单元格中怎么才能设置多级下拉菜单多选功能

就是在大区内，选随便两个大区或多个大区，然后办事处就会出现对应的办事处

许许xuxu

http://club.excelhome.net/thread-1095543-1-1.html
这个写的很详细～

XUN8176

许许xuxu 发表于 2015-2-10 16:35
http://club.excelhome.net/thread-1095543-1-1.html
这个写的很详细～

我需要的是多选，不是单选

蓝桥玄霜

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Column <> 1 Or Target.Row < 2 Then Exit Sub
   
4. Dim k, t, Arr, i&, j&, aa, oCtrl
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. On Error Resume Next
   
7. Arr = [d1].CurrentRegion
   
8. For i = 1 To UBound(Arr, 2)
   
9.     d(Arr(1, i)) = i
   
10. Next
    
11. k = d.keys
    
12. t = d.items
    
13. With Application.CommandBars.Add("临时菜单", msoBarPopup, , 1)
    
14.     With .Controls.Add(Type:=msoControlButton)
    
15.       .Caption = "请选择"
    
16.       .FaceId = 136
    
17.     End With
    
18.     For i = 0 To UBound(k)
    
19.         With .Controls.Add(msoControlPopup, 1, , , 1)
    
20.             .BeginGroup = True
    
21.             .Caption = k(i)
    
22.             For j = 2 To UBound(Arr)
    
23.                 If Arr(j, t(i)) <> "" Then
    
24.                     Set oCtrl = .Controls.Add(Type:=msoControlButton)
    
25.                     With oCtrl
    
26.                         .Caption = Arr(j, t(i))
    
27.                         .HelpFile = k(i) '引用Helpfile属性得到上一级菜单的Caption
    
28.                         .OnAction = "yy1"
    
29.                     End With
    
30.                 End If
    
31.             Next
    
32.         End With
    
33.     Next
    
34.     .ShowPopup '显示工具栏
    
35.   End With
    
36.   Application.CommandBars("临时菜单").Delete '删除工具栏
    
37. End Sub
    
38. 
    

复制代码

蓝桥玄霜

鼠标右键点击A列，显示右键快捷菜单，鼠标左键选择。
请见附件。

dvdriper

谢谢楼上,学习了