对于每个单元格…下一个单元循环只能工作一次

我的代码发现预定义范围“r”中的单元格的值为“Completed”，但使用For Each Cell和Next Cell命令不会循环代码以find多个“Completed”单元。

我错过了什么？ 任何帮助，将不胜感激。

Sub Move_Burn() Dim Msg As String, Ans As Variant Msg = "Are you sure you want to move the completed pumps?" Ans = MsgBox(Msg, vbYesNo) Select Case Ans Case vbYes Dim r As Range, cell As Range, mynumber As Long, r2 As Range Set r = Range("AR15:AR1000") Set r2 = Range("AF15:AF1000") mynumber = 1 For Each cell In r If cell.Value = "Completed" Then Range("AT15:BN15").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("AT15:BN15").Interior.ColorIndex = xlNone End If If cell.Value = "Completed" Then cell.Select cell.Value = "Delete" Range(ActiveCell, ActiveCell.Offset(0, -20)).Select Selection.Copy Range("AT15").Select ActiveSheet.Paste Range("BN15").ClearContents End If If cell.Value = "Delete" Then cell.Select Range(ActiveCell, ActiveCell.Offset(0, -20)).Select Selection.Delete Shift:=xlUp End If Next cell Case vbNo GoTo Quit: End Select Quit: End Sub 

Answer 1

您正在删除单元格，因此您需要向后循环。

改变你的循环：

 For i = 1000 To 15 Step -1 '// Your code here '// Instead of referring to cell - use Range("AR" & i) eg If Range("AR" & i).Value = "Completed" Then '// rest of code End If Next