[英]How do I loop through cells in a specific column and delete the entire row based on its contents?
这是我觉得有一个简单答案的另一个问题,但我找不到。 我遍历D列中的每个单元格,并查找特定日期(从用户输入中),并基于该单元格的日期和某些相应单元格中的日期,更改行的颜色。
除了希望为行着色之外,我希望能够删除它。
这是我当前为这些行着色的代码:
Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Select
Dim rCell, otherCell As Range
Dim TheAnswer$
Dim ConvertedDate#
TheAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _
vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY")
ConvertedDate = CDate(TheAnswer)
For Each rCell In Selection
If rCell.Value <> "" Then
If rCell.Value And rCell.Offset(, 5) < ConvertedDate And rCell.Offset(, 5) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0)
If rCell.Value < ConvertedDate And rCell.Offset(, 5) = "" Then
If rCell.Offset(, 6) < ConvertedDate And rCell.Offset(, 6) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0)
If rCell.Offset(, 7) < ConvertedDate And rCell.Offset(, 7) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0)
End If
End If
Next rCell
当我将rCell.EntireRow.Interior.Color = RGB(255, 102, 0)
rCell.EntireRow.Delete
rCell.EntireRow.Interior.Color = RGB(255, 102, 0)
替换为rCell.EntireRow.Delete
出现错误。 如果我单步执行代码,可以看到它确实删除了第一行,但是在下一行出错了。
我显然有多个“ If Then”语句,但是如果满足第一个“ If Then”条件并删除了该行,则应继续到下一个单元格。 在我看来,它仍在尝试检查已删除的行。 我绝对不是Excel VBA专家,但我认为rCell.EntireRow.Delete
部分之后应添加一些内容,以rCell.EntireRow.Delete
其移至下一个单元格。 我尝试添加Next rCell
,但是出错了。 Exit For
完全停止宏。
迈克,当您遍历范围集并删除行时,您需要从最后一行开始向后遍历,因为当您删除某行时,该行不再存在,并且它通过Excel,因为该行不再在循环范围内。
尝试这个:
Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Select
Dim rCell as Range, otherCell As Range
Dim TheAnswer$
Dim ConvertedDate#
TheAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _
vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY")
ConvertedDate = CDate(TheAnswer)
Dim xrows as Long, i as Long
xrows = Selection.Rows.Count
For i = xrows to 1 Step -1
Set rCell = Selection.Cells(i,1)
If rCell.Value <> "" Then
If rCell.Value And rCell.Offset(, 5) < ConvertedDate And rCell.Offset(, 5) <> "" Then rCell.EntireRow.Delete
If rCell.Value < ConvertedDate And rCell.Offset(, 5) = "" Then
If rCell.Offset(, 6) < ConvertedDate And rCell.Offset(, 6) <> "" Then rCell.EntireRow.Delete
If rCell.Offset(, 7) < ConvertedDate And rCell.Offset(, 7) <> "" Then rCell.EntireRow.Delete
End If
End If
Next i
不知道是否要全部都是EntireRow.Delete
,但是可以轻松地将其切换回去。
参见下文,我更新并更改了一些重复的条件。 最好的两种方法是将数据添加到变量数组中,进行处理,然后删除,或者如brettdj在评论中所述,添加标志,过滤器然后批量删除。 我喜欢以下内容,因为它可以很好地扩展,并且是其他数据操作的好习惯。 未测试为没有模板可作为基础。 见下文:
Dim data() As Variant
Dim i As Double
Dim deleteRows As Range
Dim sht As Worksheet
Dim theAnswer As String
Dim ConvertedDate As Date
Set sht = Sheet1
theAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _
vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY")
ConvertedDate = CDate(theAnswer)
data = sht.Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Resize(, 8)
For i = 1 To UBound(data, 1)
If (data(i, 1) <> vbNullString) Then
If data(i, 1) <> vbNullString And data(i, 6) < ConvertedDate And data(i, 6) <> vbNullString Then
If (deleteRows Is Nothing) Then
Set deleteRows = sht.Rows(i + 1)
Else
Set deleteRows = Union(deleteRows, sht.Rows(i + 1))
End If
ElseIf data(i, 1) < ConvertedDate And data(i, 7) <> vbNullString And data(i, 8) <> vbNullString Then
If data(i, 7) < ConvertedDate Or data(i, 8) < ConvertedDate Then
If (deleteRows Is Nothing) Then
Set deleteRows = sht.Rows(i + 1)
Else
Set deleteRows = Union(deleteRows, sht.Rows(i + 1))
End If
End If
End If
End If
Next i
deleteRows.Delete Shift:=xlUp
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.