如何在多个Excel文件中查询信息

Ncj123

sdytsxd991122 发表于 2024-8-27 11:31

感谢高手！

dy83797465268

可以用字典可以用SQL~

Ncj123

ykcbf1100 发表于 2024-8-27 10:43
用工作表事件，[e2]单元格如果为空，则列出全部数据；[e2]单元格如果不为空，则列出符合条件的数据

感谢大侠的代码，测试成功。

但是，如果用WPS运行，日期会带有星期，这怎么解决啊？
如果用Office运行，则正常，即：日期不会带有星期。

Ncj123

ykcbf1100 发表于 2024-8-27 10:44
参与一下。。。

感谢大侠的代码！

输入“王五”，测试成功。输入”张三“，则不行。

ykcbf1100

Ncj123 发表于 2024-8-28 15:01
感谢大侠的代码！

输入“王五”，测试成功。输入”张三“，则不行。

改好了，你再试一下。

ykcbf1100

改一下。。。

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2.     Application.EnableEvents = False
   
3.     Application.ScreenUpdating = False
   
4.     If T.Address <> "$E$2" Then
   
5.         Exit Sub
   
6.     Else
   
7.         Set fso = CreateObject("Scripting.FileSystemObject")
   
8.         p = ThisWorkbook.Path & ""
   
9.         xm = T.Value
   
10.         ReDim brr(1 To 10000, 1 To 6)
    
11.         For Each f In fso.GetFolder(p).Files
    
12.             If LCase(f.Name) Like "*.xls*" Then
    
13.                 If InStr(f, "~$") = 0 Then
    
14.                     If InStr(f, ThisWorkbook.Name) = 0 Then
    
15.                         Set wb = Workbooks.Open(f, 0)
    
16.                         arr = wb.Sheets(1).UsedRange
    
17.                         wb.Close 0
    
18.                         For i = 3 To UBound(arr)
    
19.                             If arr(i, 5) = T.Value Then
    
20.                                 m = m + 1
    
21.                                 brr(m, 1) = m
    
22.                                 For j = 2 To UBound(arr, 2)
    
23.                                     brr(m, j) = arr(i, j)
    
24.                                 Next
    
25.                             End If
    
26.                         Next
    
27.                     End If
    
28.                 End If
    
29.             End If
    
30.         Next
    
31.         Me.UsedRange.Offset(3).ClearContents
    
32.         If m > 0 Then Me.[a4].Resize(m, 6) = brr
    
33.     End If
    
34.     Application.EnableEvents = True
    
35.     Application.ScreenUpdating = True
    
36. End Sub
    
37. 
    

复制代码

Ncj123

ykcbf1100 发表于 2024-8-28 15:59
改好了，你再试一下。

测试成功！！！！！！感谢大侠的代码！！！！！！十分感动大侠的精神！！！！！！

另再请教一下：如果用WPS运行，日期会带有星期，这怎么解决啊？如果用Office运行，则正常，即：日期不会带有星期。

ykcbf1100

Ncj123 发表于 2024-8-28 16:12
测试成功！！！！！！感谢大侠的代码！！！！！！十分感动大侠的精神！！！！！！

另再请教一下：如果 ...

不好意思，WPS我没有，所以，我不太清楚。