VBA工单同步代码需多次执行才能完成删除归档问题求助

问题根源 #

原代码采用从上往下循环的方式处理行数据，当删除第j行后，原本的第j+1行会自动上移到第j行的位置，但循环会直接推进到j+1，导致这行刚上移的数据被跳过，最终出现隔行删除的情况，需要多次执行才能完成全部操作。

修复后的完整代码 #

Sub ArchiveAndDeleteWorkorders()
    Dim wsInProgress As Worksheet
    Dim wsMaster As Worksheet
    Dim wsArchive As Worksheet
    Dim lastRowMaster As Long
    Dim lastRowArchive As Long
    Dim j As Long
    
    ' 绑定工作表对象
    Set wsInProgress = ThisWorkbook.Worksheets("In Progress Workorders")
    Set wsMaster = ThisWorkbook.Worksheets("MASTER")
    Set wsArchive = ThisWorkbook.Worksheets("archive")
    
    ' 动态获取MASTER表最后数据行（替代硬编码的100）
    lastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, 2).End(xlUp).Row
    ' 确定archive表的归档起始行
    lastRowArchive = wsArchive.Cells(wsArchive.Rows.Count, 2).End(xlUp).Row + 1
    
    ' 从最后一行往前循环，避免删除行导致的索引错位
    For j = lastRowMaster To 3 Step -1
        ' 检查当前工单是否不在In Progress列表中
        If Application.WorksheetFunction.CountIf(wsInProgress.Range("C4:C" & wsInProgress.Cells(wsInProgress.Rows.Count, 3).End(xlUp).Row), wsMaster.Cells(j, 2)) = 0 Then
            ' 归档工单到archive表
            wsArchive.Cells(lastRowArchive, 1).Value = wsMaster.Cells(j, 1).Value
            wsArchive.Cells(lastRowArchive, 2).Value = wsMaster.Cells(j, 2).Value
            ' 删除MASTER表中的目标行
            wsMaster.Rows(j).EntireRow.Delete
            ' 更新归档起始行号
            lastRowArchive = lastRowArchive + 1
        End If
    Next j
End Sub

核心优化点 #

• 反向循环遍历：从MASTER表的最后一行向上遍历，删除行后不会影响未处理的行位置，彻底避免跳过数据。
• 动态行号适配：通过End(xlUp)获取实际数据的最后行，替代硬编码的固定行号，适配数据量变化。
• 精准范围判断：In Progress表的检查范围也采用动态行号，避免包含空行导致的无效判断。

内容的提问来源于stack exchange，提问作者user21920024