Excel VBA Worksheet_Change事件代码内存占用过高，求优化方案

I have a workbook with one worksheet containing formulas (approx 50 columns × 50 rows), file size ~500kB, no conditional formatting, and I've avoided volatile functions as much as possible. When opening the workbook, Excel uses ~180MB of memory, but after modifying a cell that triggers worksheet recalculation, memory usage jumps to 2.8GB. My only VBA code is as follows:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim varray As Variant
    Dim i As Long
    ost = Cells(Rows.Count, "M").End(xlUp).Row
    varray = Range("M1:M200").Value
    If Not Intersect(Target, Columns(13)) Is Nothing Then
        'If Not Intersect(Target, Range("A1:A3")) Is Nothing Then -- only act on changes to cells A1 to A3
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        For i = UBound(varray, 1) To LBound(varray, 1) Step -1 'Go backwards
            If i < 4 Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
            If VBA.Len(varray(i, 1)) > 0 Then
                Range(Cells(4, "T"), Cells(4, "BD")).Copy Cells(i, "T")
            Else
                Range(Cells(i, "T"), Cells(i, "BD")).ClearContents
            End If
        Next
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub

I suspect there's a flaw in this code causing the memory issue. Can I optimize it to reduce memory usage?

Answer #

Absolutely—your code has several key inefficiencies that are almost certainly driving those extreme memory spikes. Let’s break down the fixes step by step, with explanations of why each change helps:

1. Fix Early Exit Logic & Centralize Cleanup #

Right now, if your loop hits i < 4, you re-enable automatic calculation and screen updating mid-operation. This can trigger partial, unnecessary recalculations while you’re still modifying cells, leading to memory fragmentation and bloat.

Instead, move all setting-restoration code to a single cleanup block that runs regardless of how the sub exits (even if an error occurs). We’ll also simplify the loop to stop at row 4, eliminating the need to check i < 4 on every iteration.

2. Replace Copy/Paste with Direct Value Transfer #

Using Copy relies on the Windows clipboard, which can leave residual data in memory—especially if repeated 200 times. Directly assigning cell values skips the clipboard entirely, is faster, and avoids memory leaks.

3. Disable Events to Stop Recursive Triggers #

When you modify cells in columns T:BD, this can trigger another Worksheet_Change event (even if those cells just have static values). Adding Application.EnableEvents = False stops this recursion, preventing redundant code execution and memory waste.

4. Declare All Variables (Add Option Explicit) #

Your original code uses ost without declaring it. Undeclared variables can cause unexpected behavior and memory leaks—adding Option Explicit at the top of your module forces you to declare all variables, eliminating this risk.

Optimized Code #

Here’s the revised version incorporating all these fixes:

Option Explicit ' Forces variable declaration

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim varray As Variant
    Dim i As Long
    Dim lastRow As Long
    Dim targetColsCount As Long
    
    ' Exit immediately if change isn't in column 13 (M)
    If Intersect(Target, Columns(13)) Is Nothing Then Exit Sub
    
    ' Lock down Excel settings to prevent bloat/recursion
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' Ensure settings are restored even if an error occurs
    On Error GoTo Cleanup
    
    lastRow = Cells(Rows.Count, "M").End(xlUp).Row
    varray = Range("M1:M200").Value
    ' Calculate once how many columns we're working with (T to BD)
    targetColsCount = Columns("BD").Column - Columns("T").Column + 1
    
    ' Loop only from the last used row down to row 4 (no unnecessary iterations)
    For i = UBound(varray, 1) To 4 Step -1
        ' Skip rows beyond our last used row in column M
        If i > lastRow Then Continue For
        
        If VBA.Len(varray(i, 1)) > 0 Then
            ' Direct value transfer instead of copy/paste
            Cells(i, "T").Resize(1, targetColsCount).Value = _
                Cells(4, "T").Resize(1, targetColsCount).Value
        Else
            Cells(i, "T").Resize(1, targetColsCount).ClearContents
        End If
    Next i

Cleanup:
    ' Restore all Excel settings in one place
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ' Show error message if something went wrong
    If Err.Number <> 0 Then MsgBox "Error: " & Err.Description, vbExclamation
End Sub

Why This Fixes Memory Spikes #

• No clipboard usage: Eliminates leftover clipboard data that clogs memory.
• No recursive triggers: Stops repeated Worksheet_Change calls that waste resources.
• Calculation stays manual: Prevents Excel from trying to recalculate mid-modification, which causes memory fragmentation.
• Cleanup runs reliably: Ensures Excel settings are always restored to normal, even if the sub exits early.

After applying these changes, test modifying a cell in column M—you should see memory usage stay consistent instead of spiking to 2.8GB.

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