[已解决]treeview出现的不解现象

蝶·舞

图中的K类内容怎么变到了A类的三级科目里去了？
TREEVIEW.zip (12.85 KB, 下载次数: 11)

2015-8-17 20:59 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2015-8-18 10:32

蝶·舞 发表于 2015-8-18 08:46
能标注一下各段代码的意思吗？谢谢

1. Private Sub UserForm_Initialize()
   
2. Dim arr, brr(), a&
   
3. arr = ActiveSheet.UsedRange                   '定义数组
   
4. With TreeView1
   
5.     .Nodes.Clear                                         '清除
   
6.         .LineStyle = tvwRootLines                '设置线条样式
   
7.         .Style = 6                                         '设置样式
   
8.     For a = 2 To UBound(arr)                     '循环开始
   
9.         ReDim Preserve brr(1 To arr(a, 2))    '扩大或缩小当前使用的级别
   
10.         brr(arr(a, 2)) = arr(a, 1)                    '设置级别及对应的key
    
11.         If arr(a, 2) = 1 Then                          '如果级别是1
    
12.             .Nodes.Add , , arr(a, 1), arr(a, 1)   '则直接添加到根目录
    
13.         Else
    
14.             .Nodes.Add brr(arr(a, 2) - 1), 4, arr(a, 1), arr(a, 1)
    
15.             '如果级别不是1，则加入到相应的父级key : brr(arr(a,2) - 1)
    
16.         End If
    
17.     Next
    
18. End With
    
19. End Sub

复制代码

跳转到最佳答案楼层

gufengaoyue

呃，习惯了简短的变量名，这么长的看得头晕，呵呵。。
错误提示：关键字不唯一。
你把[B24]改成 2 ，看看效果，再把[B25]再改成 1 看看 。
可能在循环的时候跳过或漏了。具体我没仔细测试。
下面我的代码供参考：

1. Private Sub UserForm_Initialize()
   
2. Dim arr, brr(), a&
   
3. arr = ActiveSheet.UsedRange
   
4. With TreeView1
   
5.     .Nodes.Clear
   
6.         .LineStyle = tvwRootLines
   
7.         .Style = 6
   
8.     For a = 2 To UBound(arr)
   
9.         ReDim Preserve brr(1 To arr(a, 2)): brr(arr(a, 2)) = arr(a, 1)
   
10.         If arr(a, 2) = 1 Then
    
11.             .Nodes.Add , , arr(a, 1), arr(a, 1)
    
12.         Else
    
13.             .Nodes.Add brr(arr(a, 2) - 1), 4, arr(a, 1), arr(a, 1)
    
14.         End If
    
15.     Next
    
16. End With
    
17. End Sub
    

复制代码

蝶·舞

gufengaoyue 发表于 2015-8-17 22:39
呃，习惯了简短的变量名，这么长的看得头晕，呵呵。。
错误提示：关键字不唯一。
你把改成 2 ，看看效果， ...

能标注一下各段代码的意思吗？谢谢

gufengaoyue

蝶·舞 发表于 2015-8-18 08:46
能标注一下各段代码的意思吗？谢谢

1. Private Sub UserForm_Initialize()
   
2. Dim arr, brr(), a&
   
3. arr = ActiveSheet.UsedRange                   '定义数组
   
4. With TreeView1
   
5.     .Nodes.Clear                                         '清除
   
6.         .LineStyle = tvwRootLines                '设置线条样式
   
7.         .Style = 6                                         '设置样式
   
8.     For a = 2 To UBound(arr)                     '循环开始
   
9.         ReDim Preserve brr(1 To arr(a, 2))    '扩大或缩小当前使用的级别
   
10.         brr(arr(a, 2)) = arr(a, 1)                    '设置级别及对应的key
    
11.         If arr(a, 2) = 1 Then                          '如果级别是1
    
12.             .Nodes.Add , , arr(a, 1), arr(a, 1)   '则直接添加到根目录
    
13.         Else
    
14.             .Nodes.Add brr(arr(a, 2) - 1), 4, arr(a, 1), arr(a, 1)
    
15.             '如果级别不是1，则加入到相应的父级key : brr(arr(a,2) - 1)
    
16.         End If
    
17.     Next
    
18. End With
    
19. End Sub

复制代码

爱疯

TREEVIEW4.rar (12.37 KB, 下载次数: 5)

2015-8-18 10:43 上传

点击文件名下载附件
原因：key is not unique in collection

说明：
在执行第3行数据时，已创建过为"Level11"的Key。
在执行第25行数据时，又要创建"Level11"的Key。

解决：用分隔符（"-"）分开。

1）每当要添加节点，就接一句debug.print。好发现到哪儿时，才出错。
2）on error ，能不用就不用。








Private Sub UserForm_Initialize()
    Dim rng As Range
    Dim arr(10) As Integer
    Dim i As Integer
    Dim r As Long
    Dim n As String, pn As String
    Dim l As Long
    '    On Error Resume Next
    TreeView1.HideSelection = False
    TreeView1.LineStyle = tvwRootLines  '显示出表示可扩展节点的“+”号

    Erase arr
    i = 1
    r = 1

    With TreeView1
        .Nodes.Clear

        Set rng = Sheet1.Range("rHeaderLevel")
        If rng.Offset(r, 0).Value <> 1 Then GoTo label_Exit

        arr(i) = 1
        n = "Level" & arr(i) & "-"

        ' 加入第一个节点
        .Nodes.Add Key:=n, Text:=rng.Offset(r, -1).Value
        Debug.Print "加节点", n, rng.Offset(r, -1).Value

        r = r + 1

        While rng.Offset(r, 0).Value <> ""
            i = rng.Offset(r, 0).Value

            'Debug.Print rng.Offset(r, 0).Address, rng.Offset(r - 1, 0).Address

            If rng.Offset(r, 0).Value < rng.Offset(r - 1, 0).Value Then
                arr(i + 1) = 0
            End If

            arr(i) = arr(i) + 1

            n = "Level"

            For l = 1 To i
                n = n & arr(l) & "-"
            Next l

            If rng.Offset(r, 0).Value = 1 Then
                ' add a root node
                .Nodes.Add Key:=n, Text:=rng.Offset(r, -1).Value
                Debug.Print "加节点", n, rng.Offset(r, -1).Value
            Else
                ' add a child node
                pn = "Level"

                For l = 1 To i - 1
                    pn = pn & arr(l) & "-"
                Next l

                .Nodes.Add Relative:=pn, Relationship:=4, Key:=n, Text:=rng.Offset(r, -1).Value
                Debug.Print "加节点", pn, n, rng.Offset(r, -1).Value
            End If
            r = r + 1
        Wend

        Debug.Print .Nodes.Count

        For l = 1 To .Nodes.Count
            .Nodes(l).EnsureVisible
        Next l

        n = "Level1-"
        .Nodes(n).Selected = True
    End With

label_Exit:
    Set rng = Nothing

    For i = 1 To TreeView1.Nodes.Count    '以下三行代码是为了默认收缩状态
        TreeView1.Nodes(i).Expanded = False
    Next
End Sub

蝶·舞

爱疯 发表于 2015-8-18 10:48
原因：key is not unique in collection

说明：

一语惊醒梦中人，多谢指点