目录树查找问题

IE_Crayon

增加的窗体控件见图片所示，

因为截图，Excel页面不是活动工作簿，没显示找到的树形控件里是选中状态，实际搜索后是选中的。

1. Private Sub CommandButton1_Click()
   
2. 
   
3.     Dim n As Node, ws As Worksheet, r As Range, myreg As Object
   
4.     Dim s1 As String, s2 As String
   
5.    
   
6.     s1 = Me.TextBox1.Text
   
7.    
   
8.     Set ws = Worksheets("平台企业")
   
9.     Set myreg = CreateObject("VBScript.RegExp")
   
10.    
    
11.     myreg.Global = True
    
12.     myreg.IgnoreCase = True
    
13.     myreg.Pattern = "\s*\S*" & s1 & "\s*\S*"
    
14.    
    
15.     For Each n In TreeView1.Nodes
    
16.         
    
17.         s2 = n.Text
    
18.         
    
19.         If myreg.Test(s2) Then
    
20.         
    
21.             n.Selected = True
    
22.             TreeView1.SetFocus
    
23.             GoTo 结束
    
24.             
    
25.         End If
    
26.     Next n
    
27.    
    
28.     MsgBox "请输入正确的企业名称!"
    
29.    
    
30. 结束:
    
31. 
    
32. End Sub

复制代码

IE_Crayon

yfxfsj

IE_Crayon 发表于 2025-3-20 15:36
增加的窗体控件见图片所示，

因为截图，Excel页面不是活动工作簿，没显示找到的树形控件里是选中状态， ...

模糊搜索只能搜一个节点，如果能搜到所有节点就非常完美。比如搜“万”，点一下搜索键搜到一个带“万”字眼的企业，如果不是要搜的企业名，再继续搜下一个企业，直到搜到为止，每搜一次，显示一次节点

02761752696

yfxfsj 发表于 2025-3-20 17:03
模糊搜索只能搜一个节点，如果能搜到所有节点就非常完美。比如搜“万”，点一下搜索键搜到一个带“万”字 ...

去掉   GoTo 结束语句试试

温馨云

供参考
Private Sub CommandButton3_Click()
    Dim AA1, aa2
    Dim arr()
    ReDim Preserve arr(1 To TreeView1.Nodes.Count, 1 To 2)
    For i = 1 To TreeView1.Nodes.Count
        If TreeView1.Nodes(i).Text Like "*" & TextBox1.Text & "*" Then
            m = m + 1
            arr(m, 1) = TreeView1.Nodes(i).Text
            arr(m, 2) = TreeView1.Nodes(i).Index
        End If
    Next
   
    If m > 0 Then
        For i = 1 To m
            AA1 = arr(i, 1): aa2 = Val(arr(i, 2))
            TreeView1.Nodes(aa2).Expanded = True
            TreeView1.Nodes(aa2).Selected = True
            TreeView1.SetFocus
            If m > 1 Then
                response = MsgBox(m & "条记录第" & i & "条" & Chr(13) & AA1 & Chr(13) & "是否查看下一条记录?", vbYesNo)
                If response = vbNo Then Exit For
            End If
        Next
    End If
End Sub