Vba 如果没有一个单元格是红色或蓝色,则删除整行
下面提供了我的宏。我想删除所有的行,其中甚至没有一个单元格是蓝色或红色的!因此,宏在开始时会执行一些着色,效果非常好!但是,当我只想保留有彩色单元格的行时,它不能正常工作。宏没有告诉我它有错误。它只是运行,但从不停止运行:p有什么想法吗?非常感谢Vba 如果没有一个单元格是红色或蓝色,则删除整行,vba,excel,loops,Vba,Excel,Loops,下面提供了我的宏。我想删除所有的行,其中甚至没有一个单元格是蓝色或红色的!因此,宏在开始时会执行一些着色,效果非常好!但是,当我只想保留有彩色单元格的行时,它不能正常工作。宏没有告诉我它有错误。它只是运行,但从不停止运行:p有什么想法吗?非常感谢 Sub PO() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvent
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
试试看
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
删除行时始终从下到上进行操作。因此,我应该如何更改它?将循环从每个行的
更改为I=lastRow的到1步骤-1
。搜索一下,你会发现很多关于如何找到最后一行的例子。然后是单元格(i,1).EntireRow.Delete
它完全搞乱了:p每个地方都有错误复制上面发布的代码,然后再次尝试进行更改。使用F8单步编码。你一定是某种类型的大师或什么,因为它像一个符咒!!!!!谢谢你,伙计!!然而我想问你一件事,因为我一直在努力寻找它很长一段时间。。。您是如何同时为两个不同的单元格使用针对每种单元格类型的函数的。。。还有,这个节点是做什么的。。。最后是lr=Application.Max(.Cells(.Rows.Count,“U”).End(xlUp).Row,w.Cells(.Rows.Count,“AB”).End(xlUp.Row)这是做什么的??很抱歉问你,但我真的很想学习!1.我没有用a表示每一行,我用a表示下一行,从下一行倒转到第二行。2.列U和AB的最大底部行数以及节点?对于下一个循环,节点开始为false。如果出现任何细胞着色,则nodel为真。在循环结束时,如果nodel为false(即,该行上没有出现细胞着色),则删除该行。谢谢!!还有解释和一切!