Question

我有一系列数据，A列中包含CASE ID，而B列中则包含Issues（1到10，或者B到K列）。

一旦某些问题被排除为“正常”，则将根据其各自的列将它们从“问题”表中删除。例如：CASE ID＃25，第4期被裁定为OK，那么它将从第25行第5列（或E列）中删除，但CASE ID将保留。

目标是通过在事后进行此检查，可能会使某些行从B列开始完全空白（因为CASE ID已经存在）。

我的代码无法成功运行。运行后，它将突出显示在目标范围内并非完全空白的几行。

我正在尝试查明B2:P & lastrow范围内的行，其中整个行为空白，然后突出显示这些行并随后将其删除。

代码：

Public Sub EmptyRows()


lastrow = Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).row
On Error Resume Next
Sheets("Issues").Activate
For Each rng In Range("B2:P" & lastrow).Columns
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Interior.ColorIndex = 11
    'rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rng

Application.ScreenUpdating = True


End Sub

首先突出显示的目的是测试代码的工作情况。如果成功，它们将被完全删除。

Answer 1

运行后，它将突出显示目标范围内并非完全空白的几行。

这是因为您选择的是所有空白，而不是仅选择整行为空白的行。

请参见下面的代码

Public Sub EmptyRows()

With Sheets("Issues")

    lastrow = .Cells(Rows.Count, "A").End(xlUp).row    

    Dim rng as Range
    For Each rng In .Range("B2:B" & lastrow)

          Dim blankCount as Integer
          blankCount = Application.WorksheetFunction.CountA(rng.Resize(1,.Range("B:P").Columns.Count)) 

          If blankCount = .Range("B" & lastRow & ":P" & lastRow).Columns.Count Then

              Dim store as Range
              If store Is Nothing Then Set store = rng Else: Set store = Union(rng, store)

          End If

    Next rng

End With

store.EntireRow.Interior.ColorIndex = 11
'store.EntireRow.Delete

End Sub

首先收集范围，然后进行修改（更改颜色或删除）将有助于更快地执行代码。

Answer 2

您的描述为B到K列，但您的代码中的B到P ...

您可以这样操作（为涉及的实际列调整大小）：

Public Sub EmptyRows()
    Dim lastRow As Long, sht As Worksheet, c As Range, rngDel As Range

    Set sht = Sheets("Issues")

    For Each c In sht.Range(sht.Range("A2"), sht.Cells(Rows.Count, 1).End(xlUp)).Cells
        If Application.CountA(c.Offset(0, 1).Resize(1, 10)) = 0 Then

            'build range to delete
            If rngDel Is Nothing Then
                Set rngDel = c
            Else
                Set rngDel = Application.Union(rngDel, c)
            End If

        End If
    Next c

    'anything to flag/delete ?
    If Not rngDel Is Nothing Then
        rngDel.EntireRow.Interior.ColorIndex = 11
        'rngDel.EntireRow.Delete '<< uncomment after testing
    End If

End Sub

Answer 3

这是使用CountA

的另一种方法

For Each cell In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Dim rng As Range
    Set rng = Range("A" & cell.Row & ":" & "P" & cell.Row)

    If Application.WorksheetFunction.CountA(rng) = 1 Then
        rng.EntireRow.Interior.ColorIndex = 11
    End If
Next cell

VBA-如果范围为空，则突出显示/删除行

3 个答案: