vba利用treeview算距离

最新推荐文章于 2024-10-09 17:37:09 发布

stljsh

最新推荐文章于 2024-10-09 17:37:09 发布

阅读量679

点赞数

CC 4.0 BY-SA版权

分类专栏： VBA应用文章标签： vba integer string textbox function each

本文链接：https://blog.youkuaiyun.com/stljsh/article/details/2100966

VBA应用专栏收录该内容

1 篇文章

订阅专栏

该博客介绍了如何使用VBA在Userform中，通过treeview控件计算两个特定节点之间的距离。当用户在ComboBox中选择开始和结束节点时，程序会遍历工作表数据并返回相应的距离。博客包含Userform和模块两部分代码，展示了TreeNodeParentCount函数和computlen函数的实现。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

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