如何用VBA实现A列合并单元格时同时删除该行及上一行？优化重复代码

Absolutely! You can combine these two delete operations into a single, cleaner loop—plus, we’ll fix a subtle bug that’s likely hiding in your original code (more on that in a second).

The Problem with Your Original Code #

Running two separate top-to-bottom loops creates two key issues:

1. Redundant checks: You’re scanning the same 300 rows twice for merged cells, which wastes processing time.
2. Row index shifting: When you delete a row in the first loop, all rows below it shift up by one. This means your second loop will miss rows or target incorrect ones because the row numbers no longer match your initial loop counter.

The Fixed, Combined Solution #

We’ll loop from bottom to top (so row shifts don’t break our logic) and delete both the merged cell’s row and its preceding row in one single operation:

Sub DeleteMergedRowsWithPrevious()
    Dim i As Integer
    ' Loop from row 300 down to 2 (to avoid errors from i-1 = 0)
    For i = 300 To 2 Step -1
        ' Check if the current cell in column A is part of a merged range
        If Cells(i, 1).MergeCells = True Then
            ' Delete both the row above and the merged cell's row in one go
            Rows(i - 1 & ":" & i).EntireRow.Delete
        End If
    Next i
End Sub

Key Improvements Explained #

• Single loop, no redundancy: We check each row once, and handle both deletions immediately when a merged cell is found.
• Bottom-up looping: Deleting rows from the bottom up ensures that when we remove rows, the unprocessed rows (above the current i) don’t shift position—so our loop counter always targets the correct row.
• Batch deletion: Using Rows(i - 1 & ":" & i).EntireRow.Delete deletes two rows in one Excel operation, which is faster than deleting them separately.

Edge Case Note #

If your merged cells span multiple rows (not just single-cell merges), you’ll want to add a check to only process the first row of the merged range—otherwise, you’ll end up deleting duplicate rows. Here’s how to adjust the code for that scenario:

Sub DeleteMultiRowMergedRowsWithPrevious()
    Dim i As Integer
    For i = 300 To 2 Step -1
        With Cells(i, 1)
            ' Only act if this is the first row of a merged range
            If .MergeCells And .MergeArea.Cells(1).Row = i Then
                Rows(i - 1 & ":" & i).EntireRow.Delete
            End If
        End With
    Next i
End Sub

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