vba利用treeview算距离
来源:互联网 发布:工商局网络合同监管 编辑:程序博客网 时间:2024/04/29 05:33
Userform1代码
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Dim Sh As Worksheet, lr As Long, Rng As Range, Subrng As Range, BeginString As String, EndString As String
' Set D = CreateObject("Scripting.Dictionary")
Set Sh = ActiveSheet
lr = Sh.[a65536].End(xlUp).Row
Set Rng = Sh.Range("a2:c" & lr)
BeginString = ComboBox1.Text
EndString = ComboBox2.Text
Dim b As Integer, e As Integer
b = NodeParentCount(TreeView1.Nodes(BeginString), TreeView1)
e = NodeParentCount(TreeView1.Nodes(EndString), TreeView1)
If b >= e Then
TextBox1 = "错误条件"
Else
TextBox1 = computlen(BeginString, EndString, Rng)
End If
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
ComboBox2.Text = Node
End Sub
Private Sub UserForm_Initialize()
Dim Sh As Worksheet, lr As Long, Rng As Range, Subrng As Range, T1 As String, T2 As String
Set D = CreateObject("Scripting.Dictionary")
Set Sh = ActiveSheet
lr = Sh.[a65536].End(xlUp).Row
Set Rng = Sh.Range("a2:a" & lr)
With TreeView1
.LineStyle = tvwRootLines
For Each Subrng In Rng
If InStr(1, Subrng, "MDF") Then
.Nodes.Add , tvwFirst, CStr(Subrng), CStr(Subrng)
D.Add CStr(Subrng), CStr(Subrng)
Exit For
End If
Next
Redo:
For Each Subrng In Rng
If D.Exists(CStr(Subrng)) And Not D.Exists(CStr(Subrng.Offset(0, 1))) Then
.Nodes.Add CStr(Subrng), tvwChild, CStr(Subrng.Offset(0, 1)), CStr(Subrng.Offset(0, 1))
D.Add CStr(Subrng.Offset(0, 1)), CStr(Subrng.Offset(0, 1))
GoTo Redo
End If
Next
D.RemoveAll
With ComboBox1
.Clear
For Each Subrng In Rng
T1 = Subrng.Text
If InStr(1, T1, "MDF") Then .Text = T1: ComboBox2.Text = Subrng.Offset(0, 1)
If Not D.Exists(T1) Then
D.Add T1, T1
.AddItem T1
End If
Next
End With
D.RemoveAll
With ComboBox2
.Clear
For Each Subrng In Rng
T1 = Subrng.Offset(0, 1).Text
If Not D.Exists(T1) Then
D.Add T1, T1
.AddItem T1
End If
Next
End With
End With
End Sub
模块代码
Option Base 1
Public D As Object
Sub ShowU1()
UserForm1.Show
End Sub
Function computlen(ByVal BeginString As String, ByVal EndString As String, Rng As Range) As String
Dim Myshu1, Myshu2() As String, i As Integer, Answer As Double, j As Integer, x As String
Set D = UserForm1.TreeView1
Myshu1 = Rng
ReDim Preserve Myshu2(1 To UBound(Myshu1), 1 To 2)
For i = 1 To UBound(Myshu1)
If Myshu1(i, 2) = EndString Then
If Myshu1(i, 1) = D.Nodes(EndString).Parent Then
Myshu2(i, 1) = Myshu1(i, 1)
Myshu2(i, 2) = Myshu1(i, 2)
EndString = D.Nodes(EndString).Parent
If EndString = BeginString Then Exit For
End If
End If
Next i
For i = 1 To UBound(Myshu2)
For j = 1 To UBound(Myshu1)
If Myshu2(i, 1) = Myshu1(j, 1) And Myshu2(i, 2) = Myshu1(j, 2) Then
Answer = Answer + Myshu1(j, 3)
x = x & "|" & Myshu2(i, 1) & "|" & Myshu2(i, 2) & "|" & Myshu1(j, 3) & "| " & Chr(13)
End If
Next j
Next i
computlen = x & "总计:" & Answer
End Function
Function NodeParentCount(NodeX As Node, TreeviewX As TreeView) As Integer
Dim c As Integer, T As String
T = NodeX.Text
Do While Not TreeviewX.Nodes(T).Parent Is Nothing
T = TreeviewX.Nodes(T).Parent.Text
c = c + 1
Loop
NodeParentCount = c
End Function
- vba利用treeview算距离
- 利用经纬度计算距离
- 利用经纬度计算距离
- 利用经纬度计算距离
- 利用距离进行分类
- 利用VBA的键盘类
- 利用Excel VBA处理文档
- 利用Word VBA制作选择题
- 利用Treeview实现树形列表
- 利用Treeview实现树形列表
- 利用Treeview实现树形列表
- 利用Treeview实现树形列表
- access vba中的treeview问题,请大家救救我吧!
- 【VBA研究】Excel VBA利用ADODB访问数据库使用小结
- 【VBA研究】Excel VBA利用ADODB访问数据库使用小结
- 利用TreeView.TreeNodePopulate 事件为TreeView动态增加节点
- 利用TreeView.TreeNodePopulate 事件为TreeView动态增加节点
- 利用VBA自定义Office的快捷方式
- C#数据库事务原理及实践
- back
- 云计算泄露Google的秘密
- 利用Java生成静态HMTL页面的方法收集
- 优化字符串操作
- vba利用treeview算距离
- 转载一篇有关转换HTML到WML的文章
- 如何结合使用 Subversion 和 Eclipse
- 提前书释意
- 修改了[HTML字符查看小工具],练练手,学学JS
- 使用PL/SQL,如何获得数字的英文拼写呢?
- SOA鼻祖 Eric Newcomer谈SOA
- 圣经基本真道
- 裸奔编程之使用Servlet实现REST风格 单纯使用Servlet进行完成REST解析