Question

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

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

Answer 1

可能需要深入调查才能访问环境。不过几点：

1）文件数（1.5百万）是否恒定？只是为了确保，性能的降低不是由迭代次数引起的。（为什么我= 551？）

2）你可以避免使用：“。（（1：”＆amp; delrow）。删除“？这种范围操作会影响整体表现。

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

VBA计划越来越慢

1 个答案: