如何使用VBA对Excel数量列数据逆透视，按状态生成重复行复制到新表

核心改动说明 #

• 移除原代码中效率低、易出错的Activate、Select类操作，运行更稳定
• 新增数量列与状态的映射匹配逻辑，自动识别非空数量列并生成对应拆分行
• 保留原代码仅处理可见行的逻辑，同时支持自定义列位置、判断规则调整

Sub SplitQtyByStatus()
    Dim countSheet As Worksheet, uploadSheet As Worksheet
    Dim lastRow As Long, uploadRow As Long, i As Long
    ' 定义数量列与对应状态的映射，可根据Sheet1实际列位置修改
    Dim qtyCols, statusArr
    ' 示例：C列=GOOD QTY，D列=BAD QTY，E列=VERY BAD QTY
    qtyCols = Array("C", "D", "E")
    statusArr = Array("Status 0", "Status 1", "Status 2")
    
    Set countSheet = ThisWorkbook.Sheets("Sheet1")
    Set uploadSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' 清空Sheet2原有旧数据（仅清空第2行及以后，保留表头，不需要可注释该行）
    uploadSheet.Range("2:" & uploadSheet.Rows.Count).ClearContents
    uploadRow = 2 ' Sheet2从第2行开始写入数据，可按需调整
    
    ' 获取Sheet1数据最后一行，和原代码逻辑一致
    lastRow = countSheet.Range("F" & countSheet.Rows.Count).End(xlUp).Row
    
    ' 遍历Sheet1每一行数据（从第11行开始，和原代码逻辑一致）
    For i = 11 To lastRow
        ' 跳过隐藏行，仅处理可见行
        If Not countSheet.Rows(i).Hidden Then
            Dim j As Long
            ' 遍历所有数量列判断是否有有效值
            For j = LBound(qtyCols) To UBound(qtyCols)
                Dim qtyVal
                qtyVal = countSheet.Range(qtyCols(j) & i).Value
                ' 当前判断规则：为数字且大于0，可按需调整（比如需要保留0值就去掉qtyVal>0的条件）
                If IsNumeric(qtyVal) And qtyVal > 0 Then
                    ' 复制公共字段：示例为B列物料名称，有其他需要同步的字段可新增对应赋值语句
                    uploadSheet.Range("B" & uploadRow).Value = countSheet.Range("B" & i).Value
                    ' 写入数量值
                    uploadSheet.Range("C" & uploadRow).Value = qtyVal
                    ' 写入对应状态，当前默认放在A列，可修改列位置
                    uploadSheet.Range("A" & uploadRow).Value = statusArr(j)
                    ' Sheet2写入行号下移
                    uploadRow = uploadRow + 1
                End If
            Next j
        End If
    Next i
    
    ' 清空剪贴板，输出运行结果
    Application.CutCopyMode = False
    MsgBox "数据拆分完成，共生成" & uploadRow - 2 & "条有效数据"
End Sub

使用注意事项 #

• 如果你的Sheet1中数量列位置和示例不一致，修改qtyCols数组里的列号即可
• 状态列、公共字段、数量列的写入位置都可以根据Sheet2的表头结构自行调整赋值语句的列号
• 如果需要处理更多数量列，只需要在qtyCols和statusArr里新增对应的元素即可

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