如何在VBA中循环处理Excel数据并按规则复制行替换指定列值

原有代码问题说明 #

• 全局固定了第2行的最后一列单元格作为判断依据，循环过程中未更新取值，判断逻辑完全失效
• 未实现M列商品编号的替换逻辑
• 大量使用Select/Selection操作，执行效率低，不适合上千行的数据量
• 循环范围直接设置为Rows.Count，会遍历大量无数据空行，浪费性能
• 若需要将新行生成在当前工作表末尾，从上到下遍历会导致新生成的行也被纳入循环，出现重复处理问题

可用代码 #

Sub SplitComponentRows()
    Dim srcSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastSrcRow As Long
    Dim i As Long
    Dim targetLastRow As Long
    
    ' 配置源表和目标表，若要粘贴到当前源表，可将targetSheet设为和srcSheet一致
    Set srcSheet = ThisWorkbook.ActiveSheet ' 也可指定为ThisWorkbook.Sheets("你的源表名")
    Set targetSheet = ThisWorkbook.Sheets("Filtersets Database (2)") 
    
    ' 固定列索引，避免列顺序变动出错
    Const COL_M As Long = 13 ' M列商品编号
    Const COL_COMP1 As Long = 49 ' AW列Component 1
    Const COL_COMP2 As Long = 50 ' AX列Component 2
    Const COL_COUNT As Long = 51 ' AY列Number of Components
    
    ' 获取源表最后一行有数据的行号
    lastSrcRow = srcSheet.Cells(srcSheet.Rows.Count, COL_COUNT).End(xlUp).Row
    
    ' 从下往上遍历原有数据行，避免新生成的行被重复处理
    For i = lastSrcRow To 2 Step -1
        targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 复制整行到目标表
        srcSheet.Rows(i).Copy targetSheet.Rows(targetLastRow)
        ' 替换M列为Component 1的值
        targetSheet.Cells(targetLastRow, COL_M).Value = srcSheet.Cells(i, COL_COMP1).Value
        
        ' 如果组件数为2，再复制一次
        If srcSheet.Cells(i, COL_COUNT).Value = 2 Then
            targetLastRow = targetLastRow + 1
            srcSheet.Rows(i).Copy targetSheet.Rows(targetLastRow)
            ' 替换M列为Component 2的值
            targetSheet.Cells(targetLastRow, COL_M).Value = srcSheet.Cells(i, COL_COMP2).Value
        End If
    Next i
    
    ' 清空剪贴板
    Application.CutCopyMode = False
End Sub

关键逻辑说明 #

• 提前固定了所有需要用到的列的索引，避免表结构变动导致的列定位错误
• 从下往上遍历源数据行，完全避免新生成的行被重复纳入循环处理
• 取消了所有Select操作，直接操作单元格对象，上千行数据可以秒级跑完
• 复制行后直接定位到目标行修改M列取值，逻辑清晰不易出错

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