VBA程序变慢

我正在运行该程序将150万'.tab'格式的文件转换为excel。最初这个程序工作正常，但随后速度放慢。我在几个系统上尝试过，所有的行为都是相似的。此外，我试图清除临时文件，驱动清理，但毫无价值。我应该怎么做才能使其高效？VBA程序变慢

Sub runFiles() 
Application.DisplayAlerts = False 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Dim fso As New FileSystemObject 
Dim fldr As Object 

Dim fldrPath As String 
Dim i As Double 
Dim wb As Workbook 

fldrPath = "C:\Users\skumar150\Desktop\upwork data\RAW\ACS" 
Set fldr = fso.GetFolder(fldrPath) 

i = 551 

For Each fl In fldr.Files 
    i = i + 1 
    Set wb = Workbooks.Open(fldr.Path & "\" & fl.Name) 
    createFile "C:\Users\skumar150\Desktop\upwork data\Excel Data1\ACS3", wb, i 
    Set wb = Nothing 
    fl.Delete 

Next fl 
Application.EnableEvents = True 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 

End Sub 

Function createFile(fldrPath As String, ByRef wb1 As Workbook, vr As Double) 
Dim wb As Workbook 
Dim flName As String, fldrName As String 
Dim ws As Worksheet 
Dim delrow As Integer 
Set wb = Workbooks.Add 
Set ws = Worksheets(wb.Sheets(1).Name) 


wb1.Sheets(1).Range("a1").CurrentRegion.Copy wb.Sheets(1).Range("a1") 
fname = wb1.Name 
wb1.Close False 

With wb 
    With ws 
     .Names.Add "countyID", ws.Range("b2").Value 
     .Names.Add "Title", ws.Range("b3").Value 
     .Names.Add "rate_per", ws.Range("b4").Value 
     .Names.Add "topic", ws.Range("b5").Value 
     .Names.Add "yLabel", ws.Range("b6").Value 
     delrow = Application.WorksheetFunction.Match("METADATA END", .Range("a:a"), 0) 
     .Rows("1:" & delrow).Delete 
    End With 
    .Close True, fldrPath & "\__sk" & vr & "_" & fname & ".xlsx" 

End With 
End Function

来源

2017-03-07 Sonu Kumar

它可能需要深入调查与访问的环境。然而很少有几点：

1）文件数量（150万）是恒定的？只是为了确保性能的下降不是由迭代次数造成的。（为什么我= 551？）

2）你可以避免使用：“.Rows（”1：“& delrow）.Delete”？这样的范围操作会影响整体性能。

3）尝试在代码中放置一些定时器来测量需要多长时间即。保存Excel文件。如果90％的运行时间是由文件保存引起的，则可能是网络问题（如果您在公司网络上运行）。

来源

2017-11-15 10:54:37 MarekK

VBA程序变慢

回答

相关问题