数组直接在树形控件中显示问题

鄂龙蒙

请教：
表一中原有2列数据，想将其中1列是日期的分拆后，形成一个新数组在树形控件中，
以“年度”和“月份”显示。试做了不成功，请大师帮忙，谢谢！

树型控件的显示.rar (32.79 KB, 下载次数: 110)

2014-5-29 08:18 上传

点击文件名下载附件

鄂龙蒙

闻启学 发表于 2014-5-29 12:21
已经修改

试了，OK！太感谢了！！！
今天的鲜花用完了，明天补上。谢谢！

鄂龙蒙

闻启学 发表于 2014-5-29 12:21
已经修改

又麻烦老师了，再请问：如何实现“单号”的双击及单击的触发事件？

闻启学

我 做了大概
不完美 让高手来完善吧

1. 
   
2. Private Sub UserForm_Initialize()
   
3.     Dim nodex As Node
   
4.     Dim rng As Range
   
5.     Dim brr(), crr, arr
   
6.     Dim aa, bb, i&, d, r
   
7. 
   
8.     Dim rootnode
   
9. 
   
10.     Dim tmp As String
    
11. 
    
12.     Dim tmpmonth As String
    
13. 
    
14.     Dim mrr
    
15. 
    
16. 
    
17.     Set d = CreateObject("scripting.dictionary")
    
18. 
    
19.     Set dm = CreateObject("scripting.dictionary")
    
20.     Sheet1.Activate    '激活表1
    
21. 
    
22. 
    
23.     With TreeView1    '设置TreeView控件属性
    
24.         .Nodes.Clear
    
25.         .Style = 6
    
26.         .LineStyle = 1
    
27. 
    
28.         Set d = CreateObject("Scripting.Dictionary")
    
29.         With Worksheets("明细统计表")
    
30.             r = .Cells(.Rows.Count, 4).End(xlUp).Row
    
31.             Set rng = .Range("D4:E" & r)
    
32.             crr = rng
    
33. 
    
34.             ReDim brr(1 To UBound(crr), 1 To 3)
    
35. 
    
36.             '//分解日期
    
37. 
    
38.             For i = 1 To UBound(crr)
    
39.                 brr(i, 1) = Split(crr(i, 2), "/")(0)    '//年
    
40. 
    
41.                 brr(i, 2) = Split(crr(i, 2), "/")(1)    '//月
    
42.                 brr(i, 3) = crr(i, 1)
    
43.             Next i
    
44. 
    
45.             '//放入字典
    
46.             For i = 1 To UBound(brr)     '删除重复号码
    
47.                 If brr(i, 1) <> "" Then     '删除空行
    
48.                     d(brr(i, 1)) = d(brr(i, 1)) & " |" & brr(i, 2)
    
49.                 End If
    
50.             Next
    
51. 
    
52.         End With
    
53. 
    
54.         .Nodes.Clear
    
55. 
    
56.         Set nodex = .Nodes.Add(, , "年度", "年度")    '添加根节点
    
57. 
    
58. 
    
59. 
    
60.         For Each rootnode In d.keys
    
61.             m = m + 1
    
62.             tmp = CStr(rootnode) & "年"
    
63.             Set nodex = .Nodes.Add("年度", tvwChild, Key:=tmp, Text:=tmp)                  '添加二级节点 年份
    
64.             '
    
65.             mrr = Split(d(rootnode), "|")
    
66.             For k = 1 To UBound(mrr)
    
67.                 dm(Trim(mrr(k))) = ""
    
68.             Next
    
69.             mrr = dm.keys
    
70.             dm.RemoveAll
    
71.             '            n = 0
    
72.             For k = 0 To UBound(mrr)
    
73.                 '                n = n + 1
    
74. 
    
75.                 tmpmonth = mrr(k) & "月"
    
76.                 Debug.Print tmpmonth
    
77.                 Set nodex = .Nodes.Add(tmp, tvwChild, tmpmonth & n, tmpmonth & n)    '添加三级节点 月份
    
78. 
    
79.             Next
    
80. 
    
81. 
    
82.         Next
    
83.         '//  Set d = Nothing
    
84.     End With
    
85. End Sub

复制代码

鄂龙蒙

闻启学 发表于 2014-5-29 10:37
我 做了大概
不完美 让高手来完善吧

先谢谢您！

试了出现“关键字不唯一”

闻启学

这个可以通过的

1. Private Sub UserForm_Initialize()
   
2.     Dim nodex As Node
   
3.     Dim rng As Range
   
4.     Dim brr(), crr, arr
   
5.     Dim aa, bb, i&, d, r
   
6. 
   
7.     Dim rootnode
   
8. 
   
9.     Dim tmp As String
   
10. 
    
11.     Dim tmpmonth As String
    
12. 
    
13.     Dim mrr
    
14. 
    
15. 
    
16.     Set d = CreateObject("scripting.dictionary")
    
17. 
    
18.     Set dm = CreateObject("scripting.dictionary")
    
19.     Sheet1.Activate    '激活表1
    
20. 
    
21. 
    
22.     With TreeView1    '设置TreeView控件属性
    
23.         .Nodes.Clear
    
24.         .Style = 6
    
25.         .LineStyle = 1
    
26. 
    
27.         Set d = CreateObject("Scripting.Dictionary")
    
28.         With Worksheets("明细统计表")
    
29.             r = .Cells(.Rows.Count, 4).End(xlUp).Row
    
30.             Set rng = .Range("D4:E" & r)
    
31.             crr = rng
    
32. 
    
33.             ReDim brr(1 To UBound(crr), 1 To 3)
    
34. 
    
35.             '//分解日期
    
36. 
    
37.             For i = 1 To UBound(crr)
    
38.                 brr(i, 1) = Split(crr(i, 2), "/")(0)    '//年
    
39. 
    
40.                 brr(i, 2) = Split(crr(i, 2), "/")(1)    '//月
    
41.                 brr(i, 3) = crr(i, 1)
    
42.             Next i
    
43. 
    
44.             '//放入字典
    
45.             For i = 1 To UBound(brr)     '删除重复号码
    
46.                 If brr(i, 1) <> "" Then     '删除空行
    
47.                     d(brr(i, 1)) = d(brr(i, 1)) & " |" & brr(i, 2)
    
48.                 End If
    
49.             Next
    
50. 
    
51.         End With
    
52. 
    
53.         .Nodes.Clear
    
54. 
    
55.         Set nodex = .Nodes.Add(, , "年度", "年度")    '添加根节点
    
56.         For Each rootnode In d.keys
    
57.             m = m + 1
    
58.             tmp = CStr(rootnode) & "年"
    
59.             Set nodex = .Nodes.Add("年度", tvwChild, Key:=tmp, Text:=tmp)                  '添加二级节点 年份
    
60.             '
    
61.             mrr = Split(d(rootnode), "|")
    
62.             For k = 1 To UBound(mrr)
    
63.                 dm(Trim(mrr(k))) = ""
    
64.             Next
    
65.             mrr = dm.keys
    
66.             dm.RemoveAll
    
67.             n = 0
    
68.             For k = 0 To UBound(mrr)
    
69.                 n = n + 1
    
70.                 tmpmonth = mrr(k) & "月"
    
71.                 Debug.Print tmpmonth
    
72.                 Set nodex = .Nodes.Add(tmp, tvwChild, tmpmonth & n, tmpmonth)     '添加三级节点 月份
    
73.                
    
74.                 '//key 不可以重复 ？
    
75.                 '//不在不同分支都不可以？？
    
76.             Next
    
77.         Next
    
78.         '//  Set d = Nothing
    
79.     End With
    
80. End Sub

复制代码

鄂龙蒙

闻启学 发表于 2014-5-29 10:48
这个可以通过的

基本达到目的了，谢谢！

将单号在月份后面显示，怎么增加一级呢？再次谢谢！

闻启学

鄂龙蒙 发表于 2014-5-29 10:54
基本达到目的了，谢谢！

将单号在月份后面显示，怎么增加一级呢？再次谢谢！

已经修改

1. Private Sub UserForm_Initialize()
   
2.     Dim nodex As Node
   
3.     Dim rng As Range
   
4.     Dim brr(), crr, arr
   
5.     Dim aa, bb, i&, d, r
   
6. 
   
7.     Dim rootnode
   
8. 
   
9.     Dim tmp As String
   
10. 
    
11.     Dim tmpmonth As String
    
12. 
    
13.     Dim mrr
    
14. 
    
15.     Dim itemarr
    
16. 
    
17. 
    
18.     Set d = CreateObject("scripting.dictionary")
    
19. 
    
20.     Set dm = CreateObject("scripting.dictionary")
    
21.     Sheet1.Activate    '激活表1
    
22. 
    
23. 
    
24.     With TreeView1    '设置TreeView控件属性
    
25.         .Nodes.Clear
    
26.         .Style = 6
    
27.         .LineStyle = 1
    
28. 
    
29.         Set d = CreateObject("Scripting.Dictionary")
    
30.         With Worksheets("明细统计表")
    
31.             r = .Cells(.Rows.Count, 4).End(xlUp).Row
    
32.             Set rng = .Range("D4:E" & r)
    
33.             crr = rng
    
34. 
    
35.             ReDim brr(1 To UBound(crr), 1 To 3)
    
36. 
    
37.             '//分解日期
    
38. 
    
39.             For i = 1 To UBound(crr)
    
40.                 brr(i, 1) = Split(crr(i, 2), "/")(0)    '//年
    
41. 
    
42.                 brr(i, 2) = Format(Split(crr(i, 2), "/")(1), "00")   '//月
    
43.                 brr(i, 3) = crr(i, 1)
    
44.             Next i
    
45. 
    
46.             '//放入字典
    
47.             For i = 1 To UBound(brr)     '删除重复号码
    
48.                 If brr(i, 1) <> "" Then     '删除空行
    
49.                     d(brr(i, 1)) = d(brr(i, 1)) & "|" & brr(i, 2) & "," & brr(i, 3)
    
50. 
    
51. 
    
52.                 End If
    
53.             Next
    
54. 
    
55.         End With
    
56. 
    
57.         .Nodes.Clear
    
58. 
    
59.         Dim tmpmonths As String
    
60. 
    
61.         Dim dannumber As String
    
62. 
    
63.         Set nodex = .Nodes.Add(, , "年度", "年度")    '添加根节点
    
64.         For Each rootnode In myarrs(d.keys)
    
65.             m = m + 1
    
66.             tmp = CStr(rootnode) & "年"
    
67.             Debug.Print rootnode
    
68. 
    
69.             Set nodex = .Nodes.Add("年度", tvwChild, Key:=tmp, Text:=tmp)                  '添加二级节点 年份
    
70.             '
    
71.             mrr = Split(d(rootnode), "|")
    
72. 
    
73. 
    
74. 
    
75.             For k = 1 To UBound(mrr)
    
76.                 tmpmonths = Split(mrr(k), ",")(0)  '//月
    
77. 
    
78.                 dannumber = Split(mrr(k), ",")(1)    '//单号
    
79.                 dm(tmpmonths) = dm(tmpmonths) & "|" & dannumber
    
80.            
    
81.             Next
    
82. 
    
83.             mrr = myarrs(dm.keys)
    
84. 
    
85.             '// itemarr = myarrs(dm.items)
    
86.             Dim l As Integer
    
87. 
    
88.             n = 0
    
89.             For k = 0 To UBound(mrr)
    
90. 
    
91.                 tmpmonth = mrr(k) & "月"
    
92.                 Debug.Print tmpmonth
    
93.                 Set nodex = .Nodes.Add(tmp, tvwChild, rootnode & tmpmonth, tmpmonth)      '添加三级节点 月份
    
94.                 Debug.Print dm(mrr(k))
    
95.                 itemarr = myarrs(Split(dm(mrr(k)), "|"))
    
96. 
    
97.                 For l = 1 To UBound(itemarr)
    
98.                     n = n + 1
    
99.                     Set nodex = .Nodes.Add(rootnode & tmpmonth, tvwChild, rootnode & tmpmonth & itemarr(l) & n, itemarr(l))
    
100. 
     
101.                 Next
     
102. 
     
103.                 '//key 不可以重复 ？
     
104.                 '//不在不同分支都不可以？？
     
105.             Next
     
106.             dm.RemoveAll
     
107.         Next
     
108.         '//  Set d = Nothing
     
109.     End With
     
110. End Sub
     
111. 
     
112. Function myarrs(tmparr)
     
113. 
     
114.     Dim tmp As Variant
     
115.     For i = 0 To UBound(tmparr) - 1
     
116.         For j = 0 To UBound(tmparr) - (i + 1)
     
117.             If tmparr(j) > tmparr(j + 1) Then
     
118.                 tmp = tmparr(j): tmparr(j) = tmparr(j + 1): tmparr(j + 1) = tmp
     
119.             End If
     
120.         Next j
     
121.     Next i
     
122.     myarrs = tmparr
     
123. End Function

复制代码

闻启学

鄂龙蒙 发表于 2014-5-29 12:36
又麻烦老师了，再请问：如何实现“单号”的双击及单击的触发事件？

？？？？？？？？？？？？？？？？？

怎么回事

忘得快

闻启学 发表于 2014-5-29 12:21
已经修改

请教大侠，不能打开窗体，显示如图所示，请问如何解决？谢谢！