怎么修改代码定位需要的位置！

苏钊丶

1. Sub main() '根据数据表初始化弹出菜单
   
2.     Dim mybar As CommandBar, arr, i&, d
   
3.     On Error Resume Next
   
4.     Application.CommandBars("myCell").Delete '重设菜单前删除原菜单
   
5.     Set mybar = Application.CommandBars.Add(Name:="myCell", Position:=msoBarPopup) '创建弹出式菜单
   
6.     arr = Range("Data!A1").CurrentRegion.Value '定位数据区,源数据放入数组arr
   
7.     Set d = CreateObject("Scripting.Dictionary")
   
8.     For i = 2 To UBound(arr)  '遍历数据源行,从第2行开始
   
9.         Call 菜单(arr, i, 1, d, mybar)
   
10.     Next
    
11.     Set d = Nothing
    
12.     Set mybar = Nothing
    
13. End Sub
    
14. 
    
15. 
    
16. Sub 菜单(arr, i, n, ByVal d, ByVal myb)
    
17. '参数 arr-源数据数组,i-,n-,d-字典,myB-菜单
    
18.     Dim x, y
    
19.     x = arr(i, n) '源数组第i行第N列
    
20.     y = WorksheetFunction.CountA(Application.Index(arr, i)) '当前行的元素个数
    
21.     If Not d.Exists(x) Then '如果字典中关键字x不存在,即当前关键字未添加进菜单
    
22.         If n = y Then '如果当前列数n等于arr源数组的最大列数,即到达最后一级
    
23.             d.Add x, i '在字典d中以x为key,存为值i
    
24.             'd(x) = i
    
25.             With myb.Controls.Add(Type:=msoControlButton) '菜单加入触发按钮
    
26.                 .Caption = x '菜单按钮名称为x
    
27.                 .OnAction = "输入(" & i & "," & n & ")" '最后一级选择触发事件,完成输入
    
28. '                Debug.Print x; "输入(" & i & "," & n & ")"
    
29.             End With
    
30.         Else '如果不是最后一级菜单,则继续添加字典及菜单
    
31.             Set d(x) = CreateObject("Scripting.Dictionary")
    
32.             Set myb = myb.Controls.Add(Type:=msoControlPopup) '加入下级弹出菜单
    
33.             myb.Caption = x '菜单按钮名称为x
    
34.         End If
    
35.     Else '如果字典key已存在,菜单即引用本级内x关键字菜单
    
36.         Set myb = myb.Controls.Item(x)
    
37.     End If
    
38.    
    
39.     If n < y Then '如果当前列未到达源数据最大列
    
40.         Call 菜单(arr, i, n + 1, d(x), myb) '递归调用本过程继续生成菜单
    
41.     End If
    
42. End Sub
    
43. 
    
44. 
    
45. Sub 输入(i, m)
    
46.     Dim arr
    
47.     arr = Worksheets("Data").Range("A" & i).Resize(1, m).Value
    
48.     'ActiveCell.EntireRow.Range("A1").Resize(1, 4).ClearContents
    
49.     ActiveCell.EntireRow.Range("A1").Resize(1, m) = arr
    
50. End Sub
    
51. 
    
52. 
    
53. Public Sub SubPopBar(keys() As Variant)
    
54. '根据参数数组返回子菜单,并复制到单独的弹出菜单
    
55.     Dim intI As Integer, subB
    
56.     Dim mybar As CommandBar
    
57.     Set subB = CommandBars("myCell")
    
58.     On Error Resume Next
    
59.     For intI = 0 To UBound(keys) '获得参数列表的子菜单
    
60.         If keys(intI) <> "" Then
    
61.             Set subB = subB.Controls(keys(intI))
    
62.         Else
    
63.             Application.CommandBars("myCell").ShowPopup '如果前面几列输入的数据为空则直接弹出顶级菜单
    
64.             Exit Sub
    
65.         End If
    
66.     Next intI
    
67.     On Error Resume Next
    
68.     Application.CommandBars("myCellx").Delete '重设菜单前删除原菜单
    
69.     Set mybar = Application.CommandBars.Add(Name:="myCellx", Position:=msoBarPopup) '创建弹出式菜单
    
70.    
    
71.     For intI = 1 To subB.Controls.Count
    
72.         subB.Controls(intI).Copy Bar:=mybar '从顶级菜单中摘出需要的子菜单
    
73.     Next
    
74.     Set subB = Nothing
    
75.     Set mybar = Nothing
    
76.     Application.CommandBars("myCellx").ShowPopup
    
77. End Sub
    

复制代码

苏钊丶

一直搞不懂，比如我想要菜单从第5行开始，而不是第2行开始，要修改哪里！！

NadrsSaber

1. 8.    For i = 2 To UBound(arr)  '遍历数据源行,从第2行开始
   
2. 
   
3. 9.        Call 菜单(arr, i, 1, d, mybar)
   
4. 
   
5. 10.    Next
   
6. 没附件, 看代码, 这里不是写着第二行开始吗? 要从第五行, 就 i = 5 咯

复制代码

苏钊丶

NadrsSaber 发表于 2019-12-20 08:39

我试了，不对，会出错。

苏钊丶

附件已经上传，大佬看一下！

Q155133209

在事件里改，而不需要在模块中改！除非你不是在A列开始输入 需要在模块中修改一下。。顺带一提 你这个应该是 excel880老师的案例。

苏钊丶

Q155133209 发表于 2019-12-20 11:33
在事件里改，而不需要在模块中改！除非你不是在A列开始输入 需要在模块中修改一下。。顺带一提 你这个应该 ...

嗯，在论坛大佬那扒拉出来的东西，先感谢原作者的辛苦。

另外，我想从A5开始，事件VBA不懂，只能扒人家的代码，然后对照，下载了好多案例，没有明显的语句表示，这个就十分尴尬~