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

  

原创粉丝点击