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

Question

我有一系列数据，案例 ID 在 A 列中，问题(1 到 10，或 B 到 K 列)在 B 列以后。

一旦某些问题被排除为"正常"，它们就会根据其各自的列从问题表中删除。例如：案例 ID #25，问题 4 被裁定为正常，然后它将从第 25 行第 5 列(或 E 列)中删除，但案例 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

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

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

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