利用窗体实现查询

wang-way

在八楼基础上进行了修改   可以适应更多村或者社区  

micch

1. Dim Path0 As String
   
2. Dim Path1 As String
   
3. Dim d As Object
   
4. Private Sub CommandButton1_Click()
   
5. Unload Me
   
6. End Sub
   
7. Private Sub ListView1_DblClick()
   
8.     i = Me.ListView1.SelectedItem.Index
   
9.     If i < 0 Then Exit Sub Else s = Me.ListView1.ListItems(i).Text
   
10.     Debug.Print Path0
    
11.     Set Fso = CreateObject("scripting.filesystemobject")
    
12.     For Each fd In Fso.getfolder(Path1).subfolders
    
13.         If Len(Dir(fd.Path & "" & s, vbDirectory)) Then Shell "explorer.exe " & fd.Path & "" & s, vbNormalFocus
    
14.     Next
    
15. End Sub
    
16. Private Sub UserForm_Initialize()
    
17.     Path0 = ThisWorkbook.Path & "\档案目录.xls"
    
18.     Path1 = ThisWorkbook.Path & "\原文"
    
19.     Call GetData
    
20.     With Me.ListView1
    
21.         .ColumnHeaders.Add , , "档号", .Width / 3
    
22.         .ColumnHeaders.Add , , "题名", .Width * 2 / 3
    
23.         .View = lvwReport
    
24.     End With
    
25. End Sub
    
26. Private Sub 查询_Click()
    
27.     s = Me.TextBox1.Text
    
28.     Me.ListView1.ListItems.Clear
    
29.     For Each x In d.keys
    
30.         If InStr(x, s) Then
    
31.             i = i + 1
    
32.             Me.ListView1.ListItems.Add , , d(x)
    
33.             Me.ListView1.ListItems(i).SubItems(1) = x
    
34.         End If
    
35.     Next
    
36. End Sub
    
37. Private Sub GetData()
    
38.     Application.ScreenUpdating = False
    
39.     Set wb = Workbooks.Open(Path0)
    
40.     Set d = CreateObject("scripting.dictionary")
    
41.     With wb.Sheets(1)
    
42.         r = .UsedRange.Find("*", , -4163, 1, 1, 2).Row
    
43.         ar = .Range("A1:J" & r).Value
    
44.         For i = 2 To r
    
45.             If Len(ar(i, 10)) Then d(ar(i, 10)) = ar(i, 1)
    
46.         Next
    
47.     End With
    
48.     wb.Close False
    
49.     Application.ScreenUpdating = True
    
50. End Sub
    

复制代码

同心/ty

Qs18 发表于 2024-6-12 21:20
试一下................

谢谢老师，辛苦了。

同心/ty

wang-way 发表于 2024-6-12 22:12
在八楼基础上进行了修改   可以适应更多村或者社区

谢谢老师的帮助，代码很完善，在实际应用中那个“档案目录.xls”文件，文件名不是固定的，一般是“***镇土地确权档案目录.xls”，能否实现提示我选择那个镇的档案目录呢，或者在应用“档案目录.xsl”时，对这个文件名不需要完全匹配，只要有文件名有那4个字符，就行。那样更完美。再次谢谢老师。   
这样改也不行呀。

同心/ty

蓝桥玄霜 发表于 2024-6-12 20:46
窗体及模板代码如下：

谢谢版主的帮助。图片代码只有慢慢写，有问题再求教。

同心/ty

micch 发表于 2024-6-12 22:15

谢谢老师，求附件。

micch

同心/ty 发表于 2024-6-13 18:02
谢谢老师，求附件。

直接复制到窗体里就行

同心/ty

wang-way 发表于 2024-6-12 22:12
在八楼基础上进行了修改   可以适应更多村或者社区

老师我把你代码其中一句改了。拼凑的，解决了我“某某镇档案目录-挂接.xls”文件的文件名字统一问题。请老师提出宝贵意见，能否再精简些。

tanglf188

参与一下，原文件版本较低，出现控件兼容问题把代码复制到原来文件即可

同心/ty

tanglf188 发表于 2024-6-14 09:51
参与一下，原文件版本较低，出现控件兼容问题把代码复制到原来文件即可

谢谢老师，你的代码优点体现在窗口干净，在没有输入查询信息前，窗口是空的，加载快，其他老师都把所有信息挂接过去，有时造成电脑卡机。但有一点是双击档号并没有打开对应的文件夹。是不是在“原文”文件的路径上出了问题？还有一点，如果在搜索框中没有输入信息，误点了“档号查询”按钮，就会运行不停，能否加一个判断，没有输入信息，不运行搜索。