VBA循环迭代逐次变慢问题排查与优化咨询

Hey there, let's figure out why your VBA script is slowing down more and more with each iteration, and fix it up to handle those 500 files smoothly!

Why Your Script Is Getting Slower Over Time #

The slowdown is almost entirely due to accumulated overhead and memory bloat from a few common VBA pitfalls:

• Unreleased Objects: Every time you open a temp workbook and set temp/ws2, you're creating objects that VBA doesn't automatically clean up. By the 100th iteration, Excel is holding onto hundreds of unused objects in memory, dragging down performance.
• Select/Selection Overhead: Using Select forces Excel to interact with the UI layer even with ScreenUpdating disabled. This hidden overhead stacks up fast across hundreds of loops.
• Full Column Operations: Calculating sums on entire columns (like ws2.Range("P:P")) makes Excel process 1+ million rows every time—even if your data only uses a tiny fraction of that. Wasted computation adds up quickly.
• Missing Performance Tweaks: You turned off ScreenUpdating, but there are other Excel features running in the background (like auto-calculation or event triggers) that are still eating up resources.

Optimized Script & Step-by-Step Fixes #

Here's a revised version of your code that addresses all these issues, plus some extra tweaks to speed things up:

Sub Compute()
    Dim dt As Date
    Dim i As Long ' Use Long instead of Integer to avoid overflow with 500+ rows
    Dim myFilenm As String
    Dim tempWB As Workbook
    Dim wsData As Worksheet
    Dim wsTemp As Worksheet
    Dim lastRow As Long
    Dim sumP As Double, sumQ As Double, sumW As Double
    
    ' Initialize variables properly (assumes row 1 is your header in DATA sheet)
    Set wsData = ThisWorkbook.Sheets("DATA")
    i = 2
    
    ' Crank up performance by disabling non-essential Excel features
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual ' Turn off auto-calculation during processing
        .EnableEvents = False ' Disable event triggers (e.g., Worksheet_Change)
        .DisplayAlerts = False ' Suppress pop-ups about read-only files or links
    End With
    
    ' Ensure we reset settings even if an error occurs
    On Error GoTo Cleanup
    
    For dt = #6/5/2017# To Now
        myFilenm = "D:\data" & Format(dt, "ddmmyyyy") & ".DAT"
        If Dir(myFilenm) <> "" Then
            ' Write file metadata to DATA sheet first
            wsData.Range("A" & i).Value = myFilenm
            wsData.Range("B" & i).Value = dt
            
            ' Open temp file as read-only (faster, no accidental changes)
            Set tempWB = Workbooks.Open( _
                Filename:=myFilenm, _
                ReadOnly:=True, _
                UpdateLinks:=xlUpdateLinksNever)
            Set wsTemp = tempWB.Sheets(1) ' Avoid ActiveSheet - use explicit sheet reference
            
            ' Replace spaces without using Select/Selection
            wsTemp.Range("A:A").Replace What:=" ", Replacement:="", _
                LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
            
            ' Run TextToColumns only on rows with actual data (not entire column)
            lastRow = wsTemp.Cells(wsTemp.Rows.Count, "A").End(xlUp).Row
            wsTemp.Range("A1:A" & lastRow).TextToColumns _
                Destination:=wsTemp.Range("A1"), _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                Comma:=True, _
                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
                Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), _
                Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), _
                Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), _
                Array(24, 1), Array(25, 1), Array(26, 1)), _
                TrailingMinusNumbers:=True
            
            ' Calculate sums only on used rows (not entire columns)
            lastRow = wsTemp.Cells(wsTemp.Rows.Count, "P").End(xlUp).Row
            sumP = Application.WorksheetFunction.Sum(wsTemp.Range("P1:P" & lastRow))
            sumQ = Application.WorksheetFunction.Sum(wsTemp.Range("Q1:Q" & lastRow))
            sumW = Application.WorksheetFunction.Sum(wsTemp.Range("W1:W" & lastRow))
            
            ' Write all sum values in one go (faster than individual cell writes)
            wsData.Range("C" & i & ":E" & i).Value = Array(sumP, sumQ, sumW)
            wsData.Range("F" & i).Value = Format(Now, "HH:MM:SS")
            
            i = i + 1
            
            ' Clean up temp objects immediately to free memory
            tempWB.Close SaveChanges:=False
            Set wsTemp = Nothing
            Set tempWB = Nothing
        End If
    Next dt

Cleanup:
    ' Reset Excel to normal settings
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    ' Release remaining objects
    Set wsData = Nothing
    
    ' Optional: Let you know when processing is done
    MsgBox "Processing complete! Total files processed: " & i - 2, vbInformation
End Sub

Key Improvements Explained:

1. Memory Leak Fix: Added Set wsTemp = Nothing and Set tempWB = Nothing right after closing each temp file to free up memory immediately. The Cleanup block ensures settings are reset even if an error stops the loop.
2. Removed Select: Replaced all Select/Selection calls with explicit range references, eliminating unnecessary UI overhead.
3. Targeted Data Ranges: Used lastRow to only process rows with actual data for TextToColumns and sum calculations—cutting down on wasted computation by 99% in most cases.
4. Additional Performance Tweaks: Disabled auto-calculation, event triggers, and pop-ups to stop Excel from doing background work you don't need.
5. Batched Writes: Wrote all three sum values to the DATA sheet in a single line instead of three separate writes, reducing worksheet interaction overhead.
6. Read-Only File Opening: Added ReadOnly:=True and UpdateLinks:=xlUpdateLinksNever to speed up file opening and avoid unexpected issues.

Quick Extra Tip #

If all the columns from your TextToColumns operation use the same data type (xlGeneral/xlText), you can simplify the FieldInfo array to just Array(1,1)—Excel will apply that type to all columns automatically, making your code cleaner.

内容的提问来源于stack exchange，提问作者LOKE2707