Excel VBA如何修改代码实现按有值数量列复制重复行到另一工作表并新增状态列

实现逻辑 #

• 遍历Sheet1的所有有效行，对每行依次校验3个数量列（GOOD QTY、BAD QTY、VERY BAD QTY）是否存在有效值
• 每检测到一个有值的数量列，就将当前行的基础信息复制到Sheet2，同时填充对应的Status值和数量
• 全程避免使用Select/Activate等低效操作，直接操作工作表对象提升运行效率

前置说明 #

以下代码默认Sheet1的列对应关系如下，若你的实际列位置不同可自行调整参数：

• 数据起始行：第11行
• D列：GOOD QTY（对应Status 0）
• E列：BAD QTY（对应Status 1）
• F列：VERY BAD QTY（对应Status 2）
• 基础信息列：B、C列（商品编码、商品名称）

完整代码 #

Sub SplitDataByQty()
    Dim countSheet As Worksheet, uploadSheet As Worksheet
    Dim lastRow As Long, targetRow As Long, i As Long
    
    ' 定义工作表对象
    Set countSheet = ThisWorkbook.Sheets("Sheet1")
    Set uploadSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' 清空Sheet2原有数据（保留表头，从第2行开始写入新数据）
    targetRow = 2
    uploadSheet.Range("B2:G" & uploadSheet.Rows.Count).ClearContents
    
    ' 获取Sheet1最后一行有效行号
    lastRow = countSheet.Range("B" & countSheet.Rows.Count).End(xlUp).Row
    
    ' 遍历Sheet1每一行数据
    For i = 11 To lastRow
        ' 跳过空行
        If countSheet.Range("B" & i) <> "" Then
            ' 判断GOOD QTY是否有有效值，有则写入Sheet2
            If IsNumeric(countSheet.Range("D" & i)) And countSheet.Range("D" & i) > 0 Then
                uploadSheet.Range("B" & targetRow) = countSheet.Range("B" & i)
                uploadSheet.Range("C" & targetRow) = countSheet.Range("C" & i)
                uploadSheet.Range("D" & targetRow) = 0
                uploadSheet.Range("E" & targetRow) = countSheet.Range("D" & i)
                targetRow = targetRow + 1
            End If
            
            ' 判断BAD QTY是否有有效值，有则写入Sheet2
            If IsNumeric(countSheet.Range("E" & i)) And countSheet.Range("E" & i) > 0 Then
                uploadSheet.Range("B" & targetRow) = countSheet.Range("B" & i)
                uploadSheet.Range("C" & targetRow) = countSheet.Range("C" & i)
                uploadSheet.Range("D" & targetRow) = 1
                uploadSheet.Range("E" & targetRow) = countSheet.Range("E" & i)
                targetRow = targetRow + 1
            End If
            
            ' 判断VERY BAD QTY是否有有效值，有则写入Sheet2
            If IsNumeric(countSheet.Range("F" & i)) And countSheet.Range("F" & i) > 0 Then
                uploadSheet.Range("B" & targetRow) = countSheet.Range("B" & i)
                uploadSheet.Range("C" & targetRow) = countSheet.Range("C" & i)
                uploadSheet.Range("D" & targetRow) = 2
                uploadSheet.Range("E" & targetRow) = countSheet.Range("F" & i)
                targetRow = targetRow + 1
            End If
        End If
    Next i
    
    ' 可选：自动调整Sheet2列宽
    uploadSheet.Columns("B:E").AutoFit
End Sub

使用说明 #

• 打开Excel文件后按Alt+F11进入VBA编辑器，插入模块后粘贴上述代码
• 运行SplitDataByQty宏即可自动完成数据转换
• 若你的Sheet1列顺序、起始行等参数和预设不同，直接修改代码中对应的列号、行号即可

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