复制粘贴然后删除 For Each 循环中的行会跳过每隔一行答案

【问题标题】：Copypasting then deleting rows in a For Each loop skips every other row复制粘贴然后删除 For Each 循环中的行会跳过每隔一行
【发布时间】：2021-03-17 06:35:10
【问题描述】：

我正在一个范围内搜索任何有删除线的单元格，如果检测到删除线，那么整行将被复制粘贴到同一工作簿的另一个工作表中。

我还在搜索带有删除线的单元格上方的所有单元格，寻找第一个具有interior.color = rgb(0,0,0) 的单元格，一旦找到它就会将该数据放在另一个工作表上好吧。

Private Sub CommandButton1_Click()

Dim ipWS As Worksheet, compWS As Worksheet
Dim compDest As Range, rrCell As Range
Dim alastRow As Long

Set ipWS = ThisWorkbook.Worksheets("In Processing")
Set compWS = ThisWorkbook.Worksheets("Completed")
Set compDest = compWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

alastRow = ipWS.Cells(Rows.Count, "A").End(xlUp).Row

Dim rackRng As Range
Dim cellRng As Range
 
Application.FindFormat.Interior.Color = RGB(0, 0, 0)

For Each rrCell In ipWS.Range("A1:A" & alastRow).Cells

    If rrCell.Font.Strikethrough = True Then
    
        Set cellRng = ipWS.Range(rrCell, rrCell.End(xlToRight))
        cellRng.Copy compDest.Offset(0, 1)
        'Application.CutCopyMode = False
            
        Set rackRng = ipWS.Range(rrCell, rrCell.End(xlUp)).Find("*", , , , , xlPrevious, , , SearchFormat:=True)
        rackRng.Copy compDest
        'Application.CutCopyMode = False
            
        ipWS.Range(rrCell, rrCell.End(xlToRight)).EntireRow.Delete
            
        Set compDest = compDest.Offset(1, 0)
    End If
Next rrCell
   
With compWS.Range("A:P")
    .Font.Strikethrough = False
    .ColumnWidth = 25
    .Font.Size = 14
    .WrapText = True
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlVAlignCenter
End With

End Sub

如果我有 2 个带有删除线的单元格，它就会开始识别带有删除线的所有其他单元格，并将这些单元格留在原始工作表上。

如果我再次点击该按钮，那么被跳过的那些将移至目标工作表。

这里有一些照片

第二张图是我第一次点击按钮的结果。它会识别带有删除线的第一个单元格，然后跳过下一个单元格，然后抓取第三个单元格。
如果我再次按下按钮，那么被跳过的按钮将转到工作表。

Application.cutcopymode = false 被注释掉，因为这似乎不起作用。

我试图抓住每一个机会调出这两个工作表，但没有奏效。

【问题讨论】：

由于是循环删除行，所以需要使用反向循环For i = alastRow to 1 Step -1而不是For Each rrCell In ipWS.Range("A1:A" & alastRow).Cells
啊，我相信我在搜索中确实遇到了这个选项，但我试着让它与我已经拥有的东西一起工作，哈哈。感谢您的帮助！又一次学习新东西的机会！

标签： excel vba

【解决方案1】：

感谢@Siddharth Rout 提供正确方向的提示。


Private Sub CommandButton1_Click()

Dim ipWS As Worksheet, compWS As Worksheet
Dim compDest As Range, rrCell As Range
Dim i As Integer
Dim alastRow As Long

Set ipWS = ThisWorkbook.Worksheets("In Processing")
Set compWS = ThisWorkbook.Worksheets("Completed")


alastRow = ipWS.Cells(Rows.Count, 1).End(xlUp).Row


Dim rackRng As Range
Dim cellRng As Range

Set compDest = compWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

Application.FindFormat.Interior.Color = RGB(0, 0, 0)


For i = alastRow To 1 Step -1

            
            If Range(Cells(i, 1), Cells(i, 1)).Font.Strikethrough = True Then
           
                Set rackRng = ipWS.Range(Cells(i, 1), Cells(i, 1).End(xlUp)).Find("*", , , , , xlPrevious, , , SearchFormat:=True)
                    rackRng.Copy compDest
                        Application.CutCopyMode = False
                
                Range(Cells(i, 1), Cells(i, Columns.Count).End(xlToLeft)).Copy compDest.Offset(0, 1)
                    Application.CutCopyMode = False
                
                        Set compDest = compDest.Offset(1, 0)
                    
                    Range(Cells(i, 1), Cells(i, 1)).EntireRow.Delete
            End If

Next i
            With compWS.Range("A:P")
                .Font.Strikethrough = False
                .ColumnWidth = 25
                .Font.Size = 14
                .WrapText = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlVAlignCenter
            End With

End Sub

【讨论】：