使用VBA根据多个条件删除或高亮显示行

我试图创build一个解决以下标准的代码：如果列C中的特定单元格等于零，则删除行如果列U中的特定单元格以9开头，则删除行如果列E中的特定单元格为负值，删除行如果列C中的特定单元格以2015开头，则突出显示颜色如果列C中的特定单元格以2016开头，则突出显示与上面相同的颜色如果C列中的特定单元格以2017开始，则用不同的颜色突出显示所有其他

这是我迄今为止，我不断收到编码错误。 我知道这是非常具体的，任何帮助，不胜感激

子模块（）

Dim x As Long Dim lastrow As Long Set sSheetName = ActiveSheet.Name With Worksheets(sSheetName) lastrow = Cells(Rows.Count, 1).End(xlUp).Row For x = lastrow To 1 Step -1 If Cells(x, 3).Value = 0 Then .EntireRow.Delete If Left(Cells(x, 21), 1) = 9 Then .EntireRow.Delete If Left(Cells(x, 5), 1) = "-" Then .EntireRow.Delete If Left(Cells(x, 3), 4) = 6017 Then cell.Offset(, -6).Resize(, 21).Interior.ColorIndex = 39 If Left(Cells(x, 3), 4) = 6018 Then cell.Offset(, -6).Resize(, 21).Interior.ColorIndex = 39 If Left(Cells(x, 3), 4) = 6150 Then cell.Offset(, -6).Resize(, 21).Interior.ColorIndex = 43 Else cell.EntireRow.Interior.ColorIndex = xlNone End If 

结束小组

Answer 1

只是总结所有的评论：

 Sub Module() Dim x As Long Dim lastrow As Long sSheetName = ActiveSheet.Name With Worksheets(sSheetName) lastrow = .Cells(Rows.Count, 1).End(xlUp).Row For x = lastrow To 1 Step -1 If .Cells(x, 3).Value = 0 Then .Rows(x).Delete If Left(.Cells(x, 21), 1) = 9 Then .Rows(x).Delete If Left(.Cells(x, 5), 1) = "-" Then .Rows(x).Delete If Left(.Cells(x, 3), 4) = 6017 Then .Cells(x,1).Resize(, 21).Interior.ColorIndex = 39 ElseIf Left(.Cells(x, 3), 4) = 6018 Then .Cells(x,1).Resize(, 21).Interior.ColorIndex = 39 ElseIf Left(.Cells(x, 3), 4) = 6150 Then .Cells(x,1).Resize(, 21).Interior.ColorIndex = 43 Else .Cells(x,1).EntireRow.Interior.ColorIndex = xlNone End If Next x End with End Sub 

Answer 2

重构的代码，这应该为你工作：

 Sub tgr() Dim rDelete As Range Dim rPurple39 As Range Dim rGreen43 As Range Dim lLastRow As Long Dim i As Long With ActiveWorkbook.ActiveSheet lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("1:" & lLastRow).EntireRow.Interior.ColorIndex = xlNone For i = 1 To lLastRow If .Cells(i, "C").Value = 0 _ Or Left(.Cells(i, "U").Value, 1) = 9 _ Or Left(.Cells(i, "E").Value, 1) = "-" Then If rDelete Is Nothing Then Set rDelete = .Rows(i) Else Set rDelete = Union(rDelete, .Rows(i)) Else Select Case Left(.Cells(i, "C"), 4) Case 6017, 6018: If rPurple39 Is Nothing Then Set rPurple39 = .Cells(i, "A") Else Set rPurple39 = Union(rPurple39, .Cells(i, "A")) Case 6150: If rGreen43 Is Nothing Then Set rGreen43 = .Cells(i, "A") Else Set rGreen43 = Union(rGreen43, .Cells(i, "A")) End Select End If Next i End With If Not rDelete Is Nothing Then rDelete.EntireRow.Delete If Not rPurple39 Is Nothing Then rPurple39.Interior.ColorIndex = 39 If Not rGreen43 Is Nothing Then rGreen43.Interior.ColorIndex = 43 End Sub