使用VBA提取Product、Non conformity与日期一致的连续相似行

原代码存在的问题 #

• 循环越界风险：当循环到最后一行时，CurrentRow + 1会超出数据行范围，触发运行错误。
• 重复行提取不完整：仅判断当前行与下一行是否相同，只提取当前行，会漏掉重复组的最后一行；若有3行及以上连续重复，最后一行无法被捕获。
• 循环逻辑混乱：循环变量k未被实际使用，CurrentRow在循环内自增，导致循环流程失控。
• 缺失表头：结果表未复制原数据的表头，可读性差。
• 效率低下：每次写入数据都重新计算结果表最后一行，频繁调用End(xlUp)会拖慢运行速度。

修正后的代码 #

' 提取连续重复的不合格项行
Sub ExtractConsecutiveDuplicates()
    Dim wb As Workbook
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRowSource As Long, lastRowResult As Long
    Dim currentRow As Long, startRow As Long
    
    ' 初始化工作簿和工作表对象
    Set wb = ActiveWorkbook
    Set wsSource = wb.Sheets("DuplicateRecords") ' 源数据工作表
    ' 检查结果表是否存在，避免重复创建报错
    On Error Resume Next
    Set wsResult = wb.Sheets("Result")
    On Error GoTo 0
    If wsResult Is Nothing Then
        Set wsResult = wb.Sheets.Add
        wsResult.Name = "Result"
    End If
    
    ' 复制源数据表头到结果表
    wsSource.Rows(1).Copy wsResult.Rows(1)
    lastRowResult = 1 ' 表头已占第1行
    
    lastRowSource = wsSource.Range("V" & Rows.Count).End(xlUp).Row
    currentRow = 2
    
    Do While currentRow <= lastRowSource
        startRow = currentRow
        ' 找到连续重复组的最后一行
        Do While currentRow < lastRowSource And _
              wsSource.Range("G" & currentRow).Value2 = wsSource.Range("G" & currentRow + 1).Value2 And _
              wsSource.Range("V" & currentRow).Value2 = wsSource.Range("V" & currentRow + 1).Value2 And _
              wsSource.Range("T" & currentRow).Value2 = wsSource.Range("T" & currentRow + 1).Value2
            currentRow = currentRow + 1
        Loop
        
        ' 如果重复组行数≥2（至少连续两行相同），复制整组到结果表
        If currentRow > startRow Then
            wsSource.Rows(startRow & ":" & currentRow).Copy wsResult.Rows(lastRowResult + 1)
            lastRowResult = lastRowResult + (currentRow - startRow + 1)
        End If
        
        currentRow = currentRow + 1
    Loop
End Sub

代码改进说明 #

• 避免重复创建工作表：先检查"Result"表是否存在，防止重复运行时报错。
• 完整提取重复组：通过嵌套循环定位连续重复的最后一行，一次性复制整组行，不会遗漏任何重复行。
• 添加表头：预先复制源数据表头，结果表结构更清晰。
• 提升运行效率：用变量跟踪结果表最后行位置，减少重复计算操作。
• 消除越界风险：内层循环增加currentRow < lastRowSource判断，避免访问超出范围的单元格。

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