如何在VBA中删除具有非空的前行或后续行的空行

Question

我的工作表中有空行，我想以这样的方式删除它们：如果上面的行或者下面的行不为空，我不想删除它们。我不想删除它们，因此在前面填充的行下面至少有一个空行。

我知道如何删除工作表中的空行：

Worksheets("Sheet1").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

但我不知道如何改变它来实现它。需要一些指导如何做到这一点。

我的代码现在看起来像这样：

For Each ws In Workbooks(newwb).Sheets
    If (ws.Name <> "Sheet1") And (ws.Name <> "Sheet2") And (ws.Name <> "Sheet3") Then
        'ws.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        For i = 1 To lRow
            If Application.WorksheetFunction.CountA(ws.Range("A" & i & ":O" & i + 2)) = 0 Then
                If IsEmpty(rngBlanks) Then
                    Set rngBlanks = ws.Rows(i + 1)
                Else
                    Set rngBlanks = Union(rngBlanks, ws.Rows(i + 1))
                End If
            End If
        Next i
        rngBlanks.EntireRow.Delete
        Set rngBlanks = Nothing
    Else
        ws.Delete
    End If
Next

执行操作时，它会给我一个运行时错误“5”：行Set rngBlanks = Union(rngBlanks, ws.Rows(i+1))

处的无效过程调用或参数

Answer 1

  

我知道如何删除工作表中的空行：

没有。当您有多列时，这是一种删除空行的错误方法，而将无效。您可能希望查看This。这个使用循环和Application.WorksheetFunction.CountA。或者，您也可以使用.Autofilter。

  

但我不知道如何改变它来实现它。需要一些指导如何做到这一点。

使用与上述链接中的答案相同的逻辑。

    '~~> Loop through the rows to find which range is blank
    For i = 1 To lRow
        '~~> Checking 3 rows in one go
        If Application.WorksheetFunction.CountA(Range("A" & i & ":J" & i + 2)) = 0 Then
            If rngBlanks Is Nothing Then
                Set rngBlanks = .Rows(i + 1)
            Else
                Set rngBlanks = Union(rngBlanks, .Rows(i + 1))
            End If
        End If
    Next i

修改

请尝试此（未经测试）

For Each ws In Workbooks(newwb).Sheets
    Select Case ws.Name
    Case "Sheet1", "Sheet2", "Sheet3"
    Case Else
        With ws
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row

            For i = 1 To lRow
                If i = .Rows.Count - 1 Then Exit For

                If Application.WorksheetFunction.CountA(.Range("A" & i & ":O" & i + 2)) = 0 Then
                    If rngBlanks Is Nothing Then
                        Set rngBlanks = .Rows(i + 1)
                    Else
                        Set rngBlanks = Union(rngBlanks, .Rows(i + 1))
                    End If
                End If
            Next i

            If Not rngBlanks Is Nothing Then
                rngBlanks.Delete
                Set rngBlanks = Nothing
            End If
        End With
    End Select
Next ws

Answer 2

替代＆＃34;公式＆＃34;方法

Option Explicit

Sub main()
Dim ncols As Long
Dim colRng As Range
Dim ws As Worksheet

For Each ws In Workbooks(newwb).Sheets
    Select Case ws.Name
        Case "Sheet1", "Sheet2", "Sheet3"    
        Case Else
            With ws
                Set colRng = .Columns("A:O") '<= set the columns range you want to deal with
                ncols = colRng.Columns.Count
                With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, ncols).Offset(, ncols).Resize(, 1)
                    .FormulaR1C1 = "=IF(RC[-1]="""",IF(COUNTBLANK(indirect(""R["" & if(row()<2,1,-1) & ""]C[-" & ncols & "]"", False):R[1]C[-1])=" & 3 * ncols & ","""",1),1)"
                    .value = .value
                    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                    .ClearContents
                End With
            End With
     End Select
Next ws

End Sub

它使用＆＃34;帮助＆＃34;列突出该范围的左侧进行处理。然后在结束之前删除其内容