Excel VBA代码优化请求：对比两工作表并复制变更行至第三表

Hey there! Let's fix up your VBA script step by step. I see two key issues here—the B column highlighting not working, and duplicate row copies (plus performance hits on large datasets). Let's tackle them one by one, then put it all together with optimized code.

1. Fixing the B Column Highlighting (or Removing It) #

Your line mycell.Range("B").Interior.Color = RGB (250, 250, 50) uses invalid syntax. Range("B") doesn't target the B column cell in the same row as mycell. If you want to keep this feature, replace it with:

wsa.Cells(mycell.Row, "B").Interior.Color = RGB(250, 250, 50)

If you don't need this highlighting anymore, just delete that line entirely—no harm done.

2. Stopping Duplicate Row Copies & Boosting Performance #

The main problem is your loop runs through every single cell. When multiple cells in a row change, it copies the same row over and over. Plus, looping 1500×32=48,000 cells without optimizations will slow Excel down a lot, even cause crashes.

Here's how to fix this:

• Use a dictionary to track which rows we've already copied (so we only copy each changed row once)
• Add performance optimizations: turn off screen updating, disable events, and set calculation to manual during the script (we'll turn them back on at the end)
• Exit the column loop early once a change is found in a row (no need to check every cell)

Optimized Full Code #

Sub Changed()
    ' Enable performance optimizations to avoid crashes on large datasets
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim wsa As Worksheet, wsb As Worksheet, wse As Worksheet
    Set wsa = Sheets("Today")
    Set wsb = Sheets("Yesterday")
    Set wse = Sheets("Line Changes")
    
    Dim usedRows As Long, usedCols As Long
    usedRows = wsa.UsedRange.Rows.Count
    usedCols = wsa.UsedRange.Columns.Count
    
    Dim rowNum As Long, colNum As Long
    Dim rowChanged As Boolean
    Dim copiedRows As Object
    Set copiedRows = CreateObject("Scripting.Dictionary") ' Track rows already copied
    
    ' Clear existing data in Line Changes (remove this line if you want to keep old entries)
    wse.Cells.Clear
    
    For rowNum = 1 To usedRows
        rowChanged = False
        
        ' Check each cell in the row for differences
        For colNum = 1 To usedCols
            If wsa.Cells(rowNum, colNum).Value <> wsb.Cells(rowNum, colNum).Value Then
                rowChanged = True
                ' Highlight the changed cell (keep/remove as needed)
                wsa.Cells(rowNum, colNum).Interior.Color = RGB(250, 250, 50)
                ' Highlight B column in the same row (keep/remove as needed)
                wsa.Cells(rowNum, "B").Interior.Color = RGB(250, 250, 50)
                Exit For ' No need to check other cells once a change is found
            End If
        Next colNum
        
        ' Copy the row only if it changed AND hasn't been copied yet
        If rowChanged And Not copiedRows.Exists(rowNum) Then
            wsa.Rows(rowNum).Copy Destination:=wse.Range("A" & wse.Cells(wse.Rows.Count, "A").End(xlUp).Row + 1)
            copiedRows.Add rowNum, True ' Mark row as copied
        End If
    Next rowNum
    
    ' Restore Excel's default settings
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Change detection complete!", vbInformation
End Sub

Key Improvements Explained #

• Performance Boost: Disabling screen updates, events, and automatic calculation cuts down on Excel's overhead—critical for large datasets (1500 rows will run smoothly now)
• No Duplicates: The copiedRows dictionary ensures each changed row is copied only once, even if multiple cells in the row are different
• Efficient Checking: Once we find one changed cell in a row, we exit the column loop early to save time
• Cleaner Logic: We loop through rows first, which makes the code easier to read and maintain

Optional Adjustments #

• If you don't want to clear the "Line Changes" sheet each time, remove the wse.Cells.Clear line
• If you don't need to highlight changed cells/B column, delete the lines setting Interior.Color

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