删除所有空白行，但留下两个空行

Question

我期待删除空白行，但留下两个空白行。这是我到目前为止的代码：

Sheets("XYZ").Select 
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
Do Until blanks.Columns.Count = 2 
Loop 
End Sub 

Answer 1

我觉得有可能是更好的方式来做到这一点，但在针对您的问题试试这个。

改变我因此，3 = 2blanks离开

Dim blankRows As Integer 
Dim i As Integer 
With Sheets("Sheet1").UsedRange 
    blankRows = .Columns(1).SpecialCells(xlCellTypeBlanks).Count 

    For i = 3 To blankRows 
     Columns(1).Cells.SpecialCells(xlCellTypeBlanks)(1).EntireRow.Delete 
    Next i 
End With 

Answer 2

你可以试试这个：

Sub main() 
    Dim lastCell As Range 
    Dim blanksCount As Long 
    Dim iarea As Long, icell As Long 

    With Worksheets("XYZ") 
     With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks) 
      For iarea = .Areas.Count To 1 Step -1 
       For icell = .Areas(iarea).Count To 1 Step -1 
        blanksCount = blanksCount + 1 
        If blanksCount = 2 Then 
         Set lastCell = .Areas(iarea).Cells(icell).Offset(-1) 
         Exit For 
        End If 
       Next 
       If Not lastCell Is Nothing Then Exit For 
      Next 
     End With 
     .Range("A1", lastCell).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
    End With 
End Sub