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程序變慢

回答

相關問題