如何根据单元格背景颜色删除行

Question

我已经将一系列单元格从一张纸复制并粘贴到我想要编辑的单元格中.该范围的单元格具有行和列(当然).我希望宏做的是通过D列并检查单元格背景颜色.如果除了白色之外还有背景颜色,我希望宏删除该单元所属的整行.因此,作为最终结果,我希望宏只保留D列中的单元格没有填充或白色背景颜色的行.下面提供的代码按照预期执行该任务,但需要花费很多时间.宏起诉的总行数为700.

我提供了迄今为止我使用过的两种不同类型的代码.它们都需要这么长时间.

代码1

With ws1
lastrow2 = ws1.Range("A" & Rows.Count).End(xlUp).Row
For i = lastrow2 To 2 Step -1
nodel = False
If .Cells(i, "D").Interior.ColorIndex = 2 Then
nodel = True
End If
If .Cells(i, "D").Interior.ColorIndex = -4142 Then
nodel = True
End If
If Not nodel Then
.Rows(i).EntireRow.Delete
End If
Next i
End With

代码2

lastrow2 = ws1.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In ws1.Range("D2:D" & lastrow2)
    If Not cell.Interior.ColorIndex = 2 Or cell.Interior.ColorIndex = -4142 Then
        If DeleteRange Is Nothing Then
            Set DeleteRange = cell
        Else
            Set DeleteRange = Union(DeleteRange, cell)
        End If
    End If
Next cell
If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete

Answer 1

您应该使用代码2.关闭ScreenUpdating和Calculations将极大地加速代码.

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

lastrow2 = ws1.Range("A" & Rows.count).End(xlUp).Row
For Each cell In ws1.Range("D2:D" & lastrow2)
    If Not cell.Interior.ColorIndex = 2 Or cell.Interior.ColorIndex = -4142 Then
        If DeleteRange Is Nothing Then
            Set DeleteRange = cell
        Else
            Set DeleteRange = Union(DeleteRange, cell)
        End If
    End If
Next cell
If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True