[已解决]乱序排列的内容如何建立TREEVIEW树状目录

蝶·舞 · 发表于 2015-10-21 10:46

本帖最后由蝶·舞于 2015-10-21 12:20 编辑

快照4.jpg

如何对这两种情形应该用树状目录进行归纳

最佳答案

月排行榜 / 总排行榜

爱疯

2015-10-21 11:41

Private Sub UserForm_Initialize()
Dim A, d, i, j
A = Range("e1").CurrentRegion

With TreeView1
      .LineStyle = tvwRootLines '设置线条样式
      .Style = 6                '样式：直线、+/-号和文本
      With .Nodes
         .Clear
         '加入到根目录下
         .Add Key:="部门", Text:="部门"
         '第2级
         For j = 1 To UBound(A, 2)
            .Add "部门", 4, A(1, j), A(1, j)
         Next j
         '第3级
         For i = 2 To UBound(A)
            For j = 1 To UBound(A, 2)
               If Len(A(i, j)) Then .Add A(1, j), 4, , A(i, j)
            Next j
         Next i
      End With
End With
End Sub

TreeView的加载例6.rar (12.22 KB, 下载次数: 24)

grf1973 · 发表于 2015-10-21 11:20

难道不是用字典吗？

Sub tt()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
Dim L(1 To 100)
ReDim brr(1 To UBound(arr), 1 To UBound(arr))
For i = 2 To UBound(arr)
x = arr(i, 1)
If Not d.exists(x) Then
n = n + 1
L(n) = L(n) + 1
brr(L(n), n) = x
d(x) = n
End If
If arr(i, 2) <> "" Then
p = d(x)
L(p) = L(p) + 1
brr(L(p), p) = arr(i, 2)
End If
Next
[e11].Resize(Application.Max(L), n) = brr
End Sub

复制代码

grf1973 · 发表于 2015-10-21 11:26

不好意思搞错了，请自动忽略。。。。。。

爱疯 · 发表于 2015-10-21 11:29

Private Sub UserForm_Initialize()
Dim A, d, i, j, k
A = Range("a1").CurrentRegion
Set d = CreateObject("scripting.dictionary")

With TreeView1
      .LineStyle = tvwRootLines '设置线条样式
      .Style = 6                '样式：直线、+/-号和文本
      With .Nodes
         .Clear
         .Add Key:=A(1, 1), Text:=A(1, 1)       '加入到根目录下
         For i = 2 To UBound(A)
            If Not d.exists(A(i, 1)) Then d(A(i, 1)) = "": .Add A(1, 1), 4, A(i, 1), A(i, 1)
            .Add A(i, 1), 4, , A(i, 2)
         Next
      End With
End With
End Sub

TreeView的加载例5.rar (12.1 KB, 下载次数: 10)

爱疯 · 发表于 2015-10-21 11:41

Private Sub UserForm_Initialize()
Dim A, d, i, j
A = Range("e1").CurrentRegion

With TreeView1
      .LineStyle = tvwRootLines '设置线条样式
      .Style = 6                '样式：直线、+/-号和文本
      With .Nodes
         .Clear
         '加入到根目录下
         .Add Key:="部门", Text:="部门"
         '第2级
         For j = 1 To UBound(A, 2)
            .Add "部门", 4, A(1, j), A(1, j)
         Next j
         '第3级
         For i = 2 To UBound(A)
            For j = 1 To UBound(A, 2)
               If Len(A(i, j)) Then .Add A(1, j), 4, , A(i, j)
            Next j
         Next i
      End With
End With
End Sub

TreeView的加载例6.rar (12.22 KB, 下载次数: 24)

蝶·舞 · 发表于 2015-10-21 12:14

爱疯发表于 2015-10-21 11:29
Private Sub UserForm_Initialize()
Dim A, d, i, j, k
A = Range("a1").CurrentRegion

多谢爱疯了，坐等第二种情况

爱疯 · 发表于 2015-10-21 12:28

本帖最后由爱疯于 2015-10-22 10:32 编辑

蝶·舞发表于 2015-10-21 12:14
多谢爱疯了，坐等第二种情况

4楼和5楼，分别对应两种情况。是不是看漏了？
另外，根节点显示为部门，感觉不合适，你自己再改好了。

我改好了，收入在这里：http://www.excelpx.com/thread-365620-1-1.html

		自动登录	找回密码
密码			注册