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

我的macros在下面提供。 我想删除所有的行，其中甚至没有一个单元格是蓝色或红色！ 所以，macros在一开始就会着色，这很好用！ 但是，当我想保留具有彩色单元格的行时，它不能正常工作。 macros不告诉我，它有一个错误。 它只是运行，但从来没有停止运行：任何想法？ 非常感激！

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