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

【问题标题】：VBA - Highlight/Delete row if Range is EmptyVBA - 如果范围为空，则突出显示/删除行
【发布时间】：2019-09-07 00:24:56
【问题描述】：

我有一系列数据，CASE ID 在 A 列中，问题（1 到 10，或 B 到 K 列）在 B 列以后。

一旦某些问题被排除为“正常”，它们将根据各自的列从问题表中删除。例如：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

第一次高亮的目的是为了测试代码是否有效。如果成功，它们将被完全删除。

【问题讨论】：

标签： excel vba loops rows

【解决方案1】：

您的描述是 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

【讨论】：

如果数据集增加，我将其保留为 P 作为意外情况。我应该添加一个类似 lastcol 的方法（类似于 lastrow），并且会改变那个移动的 fwd。谢谢你的收获。

【解决方案2】：

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

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

请看下面的代码

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

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

【讨论】：

【解决方案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

【讨论】：