如果一个单元格不是红色或蓝色，则删除整行

Question

下面提供了我的宏。我想删除所有行，其中甚至没有一个单元格是蓝色或红色的！因此，宏在开始时会执行一些着色，效果很好！但是，当我只想保留具有彩色单元格的行时，它无法正常工作。宏没有告诉我它有错误。它只是运行，但从未停止运行：p 有什么想法吗？非常感谢！

Sub PO()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Worksheets("Tracker").Cells.Copy
    With Worksheets("po")
    .Cells.PasteSpecial xlValues
    .Cells.PasteSpecial xlFormats
    End With

    Sheets("po").Select

    Dim mDiff1 As Double
    mDiff1 = 0.01
    Dim mDiff2 As Double
    mDiff2 = 0.03
    Dim mDiff3 As Double
    mDiff3 = 0.01
    Dim mDiff4 As Double
    mDiff4 = 0.03

    For Each cell1 In Range(Range("U2"), Range("U2").End(xlDown))
    If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Then
    cell1.Offset(0, 1).Interior.ColorIndex = 3
    End If
    If cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then
    cell1.Offset(0, 2).Interior.ColorIndex = 5
    End If
    Next cell1

    For Each cell2 In Range(Range("AB2"), Range("AB2").End(xlDown))
    If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Then
    cell2.Offset(0, 1).Interior.ColorIndex = 3
    End If
    If cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then
    cell2.Offset(0, 2).Interior.ColorIndex = 5
    End If
    Next cell2

    Dim row As Range
    Dim cell3 As Range

    For Each row In Range("A2", Range("A2").End(xlDown).End(xlToRight)).Rows
    For Each cell3 In row.Cells
    If Not cell3.Interior.ColorIndex = 3 Or cell3.Interior.ColorIndex = 5 Then
    cell3.EntireRow.Delete
    End If
    Next cell3
    Next row

    Sheets("po").Select
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Rows(1).AutoFilter
    End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Answer 1

试试看，

Dim i As Long, lr As Long, nodel As Boolean
Dim mDiff1 As Double, mDiff2 As Double, mDiff3 As Double, mDiff4 As Double

mDiff1 = 0.01
mDiff2 = 0.03
mDiff3 = 0.01
mDiff4 = 0.03

With Worksheets("po")
    lr = Application.Max(.Cells(.Rows.Count, "U").End(xlUp).Row, _
                         .Cells(.Rows.Count, "AB").End(xlUp).Row)
    For i = lr To 2 Step -1
        nodel = False
        If .Cells(i, "U").Value2 - .Cells(i, "U").Offset(0, 1).Value2 > mDiff1 Then
            .Cells(i, "U").Offset(0, 1).Interior.ColorIndex = 3
            nodel = True
        End If
        If .Cells(i, "U").Value2 - .Cells(i, "U").Offset(0, 2).Value2 > mDiff2 Then
            .Cells(i, "U").Offset(0, 2).Interior.ColorIndex = 5
            nodel = True
        End If
        If .Cells(i, "AB").Value2 - .Cells(i, "AB").Offset(0, 1).Value2 > mDiff3 Then
            .Cells(i, "AB").Offset(0, 1).Interior.ColorIndex = 3
            nodel = True
        End If
        If .Cells(i, "AB").Value2 - .Cells(i, "AB").Offset(0, 2).Value2 > mDiff4 Then
            .Cells(i, "AB").Offset(0, 2).Interior.ColorIndex = 5
            nodel = True
        End If
        If Not nodel Then
           .Rows(i).EntireRow.Delete
        End If
    Next i
End With