|
- Sub 查询1()
- Dim Wb As Workbook, arr1, arr2(1 To 10000, 1 To 800)
- Dim k%, j%, z%, x%, Zlast%, st$, MyFile$, sel_path$
- Dim objDialog As FileDialog, f, rng As Range
- Range("A2:P" & Rows.Count) = "" '清空原有的数据
- Set objDialog = Application.FileDialog(msoFileDialogFilePicker)
- With objDialog
- .Title = "请选择文件"
- .AllowMultiSelect = True '允许选择多个文件
- .Filters.Add "Excel文件", "*.xls;*.xlsx", 1
- If .Show = 0 Then
- MsgBox "已取消操作!"
- Exit Sub
- End If
- Application.ScreenUpdating = False '关闭屏幕刷新
- End With
- st = ThisWorkbook.Sheets(1).[P1]
- For Each f In objDialog.SelectedItems
- Set Wb = Workbooks.Open(f)
- With Wb
- For x = 1 To Wb.Sheets.Count '循环打开的工作簿里的工作表
- arr1 = .Sheets(x).Range("A1").CurrentRegion.Offset(1) '把工作表区域数据装到数组arr1里
- For j = 1 To UBound(arr1, 1) '循环数组arr1里的行
- If arr1(j, 3) = st Then '判断是否和查询值相等
- k = k + 1
- For z = 1 To 8
- arr2(k, z) = arr1(j, z) '把数组arr1满足条件装到数组arr2里
- Next z
- End If
- Next j
- Next x
- .Close True '关闭wb工作簿
- End With
- Next
- [A2].Resize(k, 8) = arr2 '把数组arr2读出来
- [P2] = Application.WorksheetFunction.Sum(Range("h2:h40"))
- Application.ScreenUpdating = True '屏幕刷新
- End Sub
复制代码 请教群里的前辈,实际我的文件夹每个工作薄数据有上万条信息,
同时也是放在局域网共享文件夹中,查询时就很慢,有没有办法提升一下查询速度。
|
|