[已解决]树菜单优化及增加和修改!谢谢！

心灵之舞

Private Sub UserForm_Initialize()
Dim l As Integer, J As Integer, p As Integer, k%
    Dim Lev As Integer
    Dim nodX As Node
    Dim MyRoot As String    '根
    Dim str1 As String      '参考值1
    Dim Str2 As String      '参考值2
    Dim Str3 As String      '上索引
    Dim Str4 As String      '下索引

    TreeView1.ImageList = ImageList1  '关联图片
    arr = Sheets("汇总表").Range("E2:G" & Range("E1").End(xlDown).Row)
    Lev = 2
    MyRoot = "比赛组别"
    Set nodX = TreeView1.Nodes.Add(, tvwChild, MyRoot, MyRoot, 1)

    For l = 1 To UBound(arr)
        For J = 1 To Lev
            For p = 1 To Lev
                str1 = str1 & arr(l, p)
            Next p

            On Error Resume Next
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            Select Case J

            Case 1    '首层
                Str3 = arr(l, J)
                Set nodX = TreeView1.Nodes.Add(MyRoot, tvwChild, Str3, Str3, J + 1)

            Case Lev     '其它层

                For p = 1 To J
                    Str2 = Str2 & arr(l, p)
                Next p
                If InStr(str1, Str2) Then
                    Str2 = ""
                    str1 = ""
                    Str4 = arr(l, J)
                    Set nodX = TreeView1.Nodes.Add(Str3, tvwChild, Str4, Str4, J + 1)
                End If
                       End Select
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            On Error GoTo 0
        Next J
    Next l
End Sub
树菜单位代码优化.zip (23.43 KB, 下载次数: 13)

2014-2-14 14:18 上传

点击文件名下载附件 请论坛大师帮我把这段代码优化一下。层数是两层时代码优化一下？如果只有一层如何优化？是否可以增加结点或修改节点？谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-2-14 15:29

1. Private Sub UserForm_Initialize()
   
2.     Dim l As Integer
   
3.     Dim nodX As Node
   
4.     Dim MyRoot As String    '根
   
5.     TreeView1.ImageList = ImageList1  '关联图片
   
6.     arr = Sheets("汇总表").Range("E2:G" & Range("E1").End(xlDown).Row)
   
7.     MyRoot = "比赛组别"
   
8.     Set nodX = TreeView1.Nodes.Add(, tvwChild, MyRoot, MyRoot, 1)
   
9.     On Error Resume Next
   
10.     For l = 1 To UBound(arr)
    
11.         Set nodX = TreeView1.Nodes.Add(MyRoot, tvwChild, arr(l, 1), arr(l, 1), 2)
    
12.         Set nodX = TreeView1.Nodes.Add(arr(l, 1), tvwChild, arr(l, 2), arr(l, 2), 3)
    
13.     Next
    
14. End Sub

复制代码

原有代码循环太多，你都用了on error resume next就直接一次添加吧。

跳转到最佳答案楼层

hwc2ycy

1. Private Sub UserForm_Initialize()
   
2.     Dim l As Integer
   
3.     Dim nodX As Node
   
4.     Dim MyRoot As String    '根
   
5.     TreeView1.ImageList = ImageList1  '关联图片
   
6.     arr = Sheets("汇总表").Range("E2:G" & Range("E1").End(xlDown).Row)
   
7.     MyRoot = "比赛组别"
   
8.     Set nodX = TreeView1.Nodes.Add(, tvwChild, MyRoot, MyRoot, 1)
   
9.     On Error Resume Next
   
10.     For l = 1 To UBound(arr)
    
11.         Set nodX = TreeView1.Nodes.Add(MyRoot, tvwChild, arr(l, 1), arr(l, 1), 2)
    
12.         Set nodX = TreeView1.Nodes.Add(arr(l, 1), tvwChild, arr(l, 2), arr(l, 2), 3)
    
13.     Next
    
14. End Sub

复制代码

原有代码循环太多，你都用了on error resume next就直接一次添加吧。

hwc2ycy

模拟的，不知道你是要修改名称还是什么
其实修改也好，增加也好，删除也好，你都是针对这些控件操作，应该不难的。
添加的代码能理解的话。

心灵之舞

修改名称、增加项目，主要是数组有点不明白！谢谢！元宵节快乐！

心灵之舞

只修改节点的难度不大，但要返回数据表确有点难，而且还有数组的，不知能否帮助解答，谢谢！

hwc2ycy

心灵之舞 发表于 2014-2-14 19:04
只修改节点的难度不大，但要返回数据表确有点难，而且还有数组的，不知能否帮助解答，谢谢！

回复特定楼层的消息，在楼层下有个回复。
如果是要修改数据，那不如直接用LISTVIEW或LISTBOX来比较好。

心灵之舞

如果是批量修改比赛项目名称时，则直接修改树菜单同时修改数据源则更快，不知有没有办法可以做到，谢谢！