Excel vba读取大量文件的速度更快 [英] Excel vba reading large amount of files faster

问题描述

我已经写了一个代码，找到所有以特定名称开始的文件，并从中读取数据，文件夹中通常有1k或更多的文件，我写了一点基准，意识到我的代码每秒读取一个aprox 1个文件，那是很多时间。我是vba的新手，我想知道我是否错了这个错误？
函数代码：

 函数ReadDataFromWorksheet（）
 Dim XL As Excel.Application 
 Dim WBK As Excel.Workbook 
 Dim i As Integer 
 
i = 1 
 
设置XL = CreateObject（Excel.Application）
 
当我& （ArraySize + 1）
设置WBK = XL.Workbooks.Open（PATH TO FILE）
数组（i）.Data1 = WBK.ActiveSheet.Range（F6）。值
 WBK.Close SaveChanges：= False 
i = i + 1 
循环
 
设置XL =没有
结束函数
  

对不起我的拼写错误！谢谢你提前帮助！

解决方案

这是你应该如何使用目录：

 函数ReadDataFromWorksheet（）As Variant 
 
应用程序
 .EnableEvents = False'停止执行此代码，直到我们完成
 .DisplayAlerts = False 
 .ScreenUpdating = False 
'.Calculation = xlCalculationManual 
结束
 
 Dim XL As Excel.Application 
 Dim WBK As Excel.Workbook 
 Dim FileName As String，_ 
 FolderPath As String，_ 
结果（）
 ReDim结果（0）
 
错误恢复下一步
设置XL = GetObject（ ，Excel.Application）
如果Err.Number> 0然后设置XL = CreateObject（Excel.Application）
错误GoTo 0 
 
 FolderPath =C：/ test /
 FileName = Dir（FolderPath& * .xlsx）
 
尽管FileName<> 
设置WBK = XL.Workbooks.Open（FolderPath& FileName）
结果（UBound（Results））= WBK.ActiveSheet.Range（F6）值
 WBK。关闭SaveChanges：= False 
 ReDim保存结果（UBound（Results）+ 1）
 FileName = Dir 
循环
 ReDim保存结果（UBound（Results） -  1）
 
设置WBK =没有
设置XL =没有
 
应用程序
 .EnableEvents = True 
 .DisplayAlerts = True 
 .ScreenUpdating = True 
'.Calculation = xlCalculationAutomatic 
结束
 
 ReadDataFromWorksheet =结果
结束功能
  

I have vritten a code that finds all files starting with specific name and reads data from them, there is usually 1k files or more in the folder, i wrote a little benchmark and realize that my code reads aprox 1 file per second and that is a lot of time. I am prety new to vba, and i was wondering if i took a wrong aproach to this ? Function Code:

Function ReadDataFromWorksheet()
Dim XL As Excel.Application
Dim WBK As Excel.Workbook
Dim i As Integer

i = 1

Set XL = CreateObject("Excel.Application")

Do While i < (ArraySize + 1)
    Set WBK = XL.Workbooks.Open("PATH TO FILE")
    Array(i).Data1 = WBK.ActiveSheet.Range("F6").Value
    WBK.Close SaveChanges:=False
    i = i + 1
Loop

Set XL = Nothing
End Function

Sorry for my bad spelling!... and thank you in advance for help!

解决方案

Here is how you should use the Dir :

Function ReadDataFromWorksheet() As Variant

With Application
    .EnableEvents = False 'stop executing this code until we are done
    .DisplayAlerts = False
    .ScreenUpdating = False
    '.Calculation = xlCalculationManual
End With

Dim XL As Excel.Application
Dim WBK As Excel.Workbook
Dim FileName As String, _
    FolderPath As String, _
    Results()
ReDim Results(0)

On Error Resume Next
Set XL = GetObject(, "Excel.Application")
If Err.Number > 0 Then Set XL = CreateObject("Excel.Application")
On Error GoTo 0

FolderPath = "C:/test/"
FileName = Dir(FolderPath & "*.xlsx")

Do While FileName <> ""
    Set WBK = XL.Workbooks.Open(FolderPath & FileName)
    Results(UBound(Results)) = WBK.ActiveSheet.Range("F6").Value
    WBK.Close SaveChanges:=False
    ReDim Preserve Results(UBound(Results) + 1)
    FileName = Dir
Loop
ReDim Preserve Results(UBound(Results) - 1)

Set WBK = Nothing
Set XL = Nothing

With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
    '.Calculation = xlCalculationAutomatic
End With

ReadDataFromWorksheet = Results
End Function

这篇关于Excel vba读取大量文件的速度更快的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！