删除范围内除最后一行以外的空白行

Question

我有这段代码，我可以在其中搜索前两个空白单元格，然后在第一个包含空白的单元格上放置一个“x”。出于测试目的，我将代码分成两个命令按钮。对于第一个命令按钮搜索空白单元格并放置“x”，第二个命令按钮找到“x”并删除行和它后面的所有其他行。

我的问题是，我希望它删除“x”之后的所有行，但保留包含总计的最后一行。

这是我的两个命令按钮的代码：

Sub findEmptyCells()

Dim lastRow As Long, i As Long
Dim firstEmptyCell As Range

lastRow = Cells(Rows.Count, 12).End(xlUp).Row 

For i = 12 To lastRow
If Cells(i, 12).Value = "" And Cells(i + 1, 12).Value = "" Then
    Set firstEmptyCell = Cells(i, 12)
    Exit For
End If
Next i

MsgBox ("There are no two empty cells in a row")
Exit Sub
End If

firstEmptyCell.Value = "x"
End Sub



Sub Deleterows_Click()

Dim srchRng As Range

Set srchRng = Range("L7:L500")

Dim c As Range
For Each c In srchRng
If c.Value = "x" Then
    
Range(c, Range("L500")).EntireRow.Delete
              
    Exit For
End If
Next

End Sub

Answer 1

删除由合并的单元格标识的行

Option Explicit

Sub DeleteRows()
    
    Const Col As String = "L"
    Const fRow As Long = 13
    Const mcCount As Long = 5
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
    
    Dim cCell As Range
    Dim r As Long

    For r = fRow To lRow - mcCount
        'Debug.Print r
        Set cCell = ws.Cells(r, Col)
        If cCell.MergeArea.Cells.Count = mcCount Then
            If Len(CStr(cCell.Value)) = 0 Then
                cCell.Offset(-1).Resize(lRow - r + 1).EntireRow.Delete
                Exit For
            End If
            r = r + mcCount - 1
        End If
    Next r
    
    MsgBox "Rows deleted.", vbInformation

End Sub

删除范围内除最后一行以外的空白行

Delete blank rows on range except last row

excel

vba

rows

删除由合并的单元格标识的行