excelhome中有关BOM的部分内容

yiyiyicz

1. Sub t02()
   
2. '** 添加引用 microsoft xml v6.0 **
   
3. Dim Arr, nrr
   
4. Dim Dic, K, T
   
5. Dim Tt As New MSXML2.DOMDocument, Rt As IXMLDOMElement, Ndt As IXMLDOMElement, Nlt As IXMLDOMNode
   
6. Dim Nlist As MSXML2.IXMLDOMNodeList
   
7. Dim Routelist As String, Routemax As Integer, Tempmax As Integer
   
8.     Set Tt = CreateObject("msxml2.domdocument")
   
9.     Tt.setProperty "SelectionLanguage", "XPath"
   
10.     lastrow = Sheet1.Range("a65536").End(xlUp).Row
    
11.     Arr = Sheet1.Range("a2:c" & lastrow)
    
12.     Set Tt = New MSXML2.DOMDocument
    
13.     Set Rt = Tt.createElement("xmltree")
    
14.     Set Tt.documentElement = Rt '//xml树之根节点
    
15.    
    
16.     '=== 建立xml树 ===
    
17.     Set Ndt = Tt.createElement("s" & Arr(1, 1)) '//添加树形图根节点“1”。由于xml的原因，自然数前要加字母变为“s1”
    
18.     Call Ndt.setAttribute("edge", "10") '//设定相邻两结点之间的边长（属性）
    
19.     Call Ndt.setAttribute("route", "s1") '//设定路径属性，记录路径上的所有结点
    
20.     Call Ndt.setAttribute("tleaf", "tt") '//设定叶结点属性，初始标注为叶结点
    
21.     Call Ndt.setAttribute("branchedge", "0") '存叶结点之间的最大路径长度
    
22.     Call Ndt.setAttribute("branchroute", "") '存叶结点之间的最大路径长度的结点编号集合
    
23.     Rt.appendChild Ndt
    
24.     For i = 1 To UBound(Arr) '添加所有的子节点
    
25.         tempt = "s" & Arr(i, 1)
    
26.         Set Nlist = Tt.getElementsByTagName(tempt)
    
27.         If Nlist.Length > 1 Then MsgBox "结点重复": Exit Sub
    
28.         Set Rt = Nlist.Item(0)
    
29.         Rt.removeAttribute ("tleaf") '//删除标注为叶节点属性
    
30.         Call Rt.setAttribute("fleaf", "ff") '//新增非叶结点的属性，是为非叶结点的标识
    
31.         Set Ndt = Tt.createElement("s" & Arr(i, 2))
    
32.         Rt.appendChild Ndt
    
33.         Call Ndt.setAttribute("edge", Arr(i, 3)) '由根节点到叶结点的累加路径长度
    
34.         Call Ndt.setAttribute("route", "s" & Arr(i, 2)) '结点编号（存结点编号集合）
    
35.         Call Ndt.setAttribute("tleaf", "tt") '标识叶结点
    
36.     Next i
    
37.     'Tt.Save "F:\creatxml.xml"'##调试用
    
38.    
    
39.     '=== 处理xml树，找最长路径 ===
    
40.     Set Nlist = Tt.selectNodes("//*[@tleaf]") '列出叶叶结点集合，属性为tleaf的元素结点。此处为Xpath语句
    
41.     '====== 逐层、逐个处理叶结点 ======
    
42.     Do Until Nlist.Length = 1 '当只剩一个tleaf属性时，逐层、逐个处理叶结点过程结束
    
43.         Set Dic = CreateObject("Scripting.Dictionary")
    
44.         For Each Nlt In Nlist '该循环后，得到叶结点的父结点的子结点数量。如果叶结点的父结点的子结点数量多于叶结点的数量，暂不处理
    
45.             Dic(Nlt.parentNode.nodeName) = Dic(Nlt.parentNode.nodeName) + 1 '叶结点的父结点出现的次数，即叶结点的父结点的子结点数量
    
46.         Next
    
47.         For Each Nlt In Nlist '该循环后，保留符合处理条件的叶结点的父结点
    
48.             Set Nlist = Nlt.parentNode.childNodes '叶结点的兄弟结点集合
    
49.             If Dic.Exists(Nlt.parentNode.nodeName) Then
    
50.                 If Not Dic(Nlt.parentNode.nodeName) = Nlist.Length Then '叶结点的父结点的子结点的数量不等于叶结点的父结点出现的次数
    
51.                     Dic.Remove (Nlt.parentNode.nodeName) '删除该父结点，因为它的子节点数量不等于叶结点数量
    
52.                 End If
    
53.             End If
    
54.         Next
    
55.         K = Dic.keys
    
56.         For Each k1 In K
    
57.             Set Rt = Tt.getElementsByTagName(k1).Item(0) '找叶结点的父结点
    
58.             If Not Rt Is Nothing Then
    
59.                 Set Nlist = Rt.childNodes
    
60.                 Routemax = 0
    
61.                 Tempmax = 0
    
62.                 '==== 累加结点间的路径长度，添加路径结点集合 ====
    
63.                 For i = 1 To Nlist.Length - 1 '两层循环为找最长路径
    
64.                     For j = i + 1 To Nlist.Length
    
65.                         Tempmax = CInt(Rt.childNodes(i - 1).Attributes(0).nodeValue) _
    
66.                             + CInt(Rt.childNodes(j - 1).Attributes(0).nodeValue)
    
67.                         If Tempmax > Routemax Then
    
68.                             Routemax = Tempmax '最长路径值记入中间变量
    
69.                             Routelist = ""
    
70.                             Routelist = Rt.childNodes(i - 1).Attributes(1).nodeValue & Rt.childNodes(j - 1).Attributes(1).nodeValue   '最长路径路过的结点
    
71.                         End If
    
72.                     Next j
    
73.                 Next i
    
74.                 If CInt(Tt.getElementsByTagName("s1").Item(0).Attributes(2).nodeValue) < Routemax Then  '比较已有的
    
75.                     Tt.getElementsByTagName("s1").Item(0).Attributes(2).nodeValue = Routemax '最长路径值存入根结点属性中
    
76.                     Tt.getElementsByTagName("s1").Item(0).Attributes(3).nodeValue = Routelist '最长路径路过的结点存入根结点属性中
    
77.                 End If
    
78.                 Routemax = 0
    
79.                 Routelist = ""
    
80.                 '==== 累加根结点到叶结点间的路径长度，添加路径结点集合 ====
    
81.                 For i = 0 To Nlist.Length - 1
    
82.                     'MsgBox Rt.childNodes(i).Attributes(0).nodeValue & "," & Rt.childNodes(i).Attributes(0).nodeName & "," & Rt.childNodes(i).nodeName
    
83.                     If CInt(Rt.childNodes(i).Attributes(0).nodeValue) > Routemax Then
    
84.                         Routemax = Rt.childNodes(i).Attributes(0).nodeValue
    
85.                         Routelist = ""
    
86.                         Routelist = Rt.childNodes(i).Attributes(1).nodeValue
    
87.                     End If
    
88.                 Next i
    
89.                 Rt.Attributes(0).nodeValue = Rt.Attributes(0).nodeValue + Routemax
    
90.                 Rt.Attributes(1).nodeValue = Routelist & Rt.Attributes(1).nodeValue
    
91.                 '==== 删除处理过的叶节点并修改其父结点的非叶结点的标识为叶结点 ====
    
92.                 Rt.removeAttribute ("fleaf")
    
93.                 Call Rt.setAttribute("tleaf", "tt")
    
94.                 For i = 0 To Nlist.Length - 1
    
95.                     Set Ndt = Rt.childNodes(0) '注意：childNodes的Index只能设置为0
    
96.                     Call Ndt.parentNode.removeChild(Ndt)
    
97.                     Set Ndt = Nothing
    
98.                 Next i
    
99.             End If
    
100.         Next
     
101.         Tt.Save "F:\creatxml.xml"
     
102.         Set Nlist = Tt.selectNodes("//*[@tleaf]")
     
103.         Set Dic = Nothing
     
104.     Loop
     
105.     'Tt.Save "F:\creatxml.xml"'##调试用
     
106.     '比较"根节点到叶结点的累加路径长度"(edge)与"叶结点之间的最大路径长度"(branchedge)，谁大
     
107.     If CInt(Rt.Attributes(0).nodeValue) > CInt(Rt.Attributes(2).nodeValue) Then
     
108.         MsgBox Space(4) & "最大路径长度" & Chr(10) & Space(10) & Rt.Attributes(0).nodeValue _
     
109.             & Chr(10) & Space(4) & "最大路径结点集合列表" & Chr(10) & Space(10) & Rt.Attributes(1).nodeValue
     
110.     Else
     
111.         MsgBox Space(4) & "最大路径长度" & Chr(10) & Space(10) & Rt.Attributes(2).nodeValue _
     
112.             & Chr(10) & Space(4) & "最大路径结点集合列表" & Chr(10) & Space(10) & Rt.Attributes(3).nodeValue
     
113.     End If
     
114. End Sub

复制代码

原帖链接
http://club.excelhome.net/thread-1163712-7-1.html

一种对树形图的分析

tom007

真的是太好了，好好学习。争取早日做出自己的作品与大家共享。

sdbz001

谢谢楼主，收下慢慢学习!

dongwengui1984

非常好，慢慢学习，谢谢

blackttea1

真的是太好了，好好学习。

23号人生

学习中。。。。

wbjjzhu

还常好的资源贴子，留个记号学习。

02761752696

谢谢分享      学习

wsc771

感谢分享..

fhb197999

感谢分享，好好学习！