Excel/Google Sheets数据拆分需求：将发票行按4列项目转为单行条目

以下是针对需求的VBA脚本，可自动将每行的多组项目拆分至新行，并保留对应发票明细（A-D列），同时跳过全零的项目组：

Sub SplitInvoiceItems()
    Dim wsRaw As Worksheet, wsOutput As Worksheet
    Dim lastRowRaw As Long, lastColRaw As Long
    Dim currentRowRaw As Long, currentRowOutput As Long
    Dim itemColStart As Integer, itemColEnd As Integer
    Dim isItemValid As Boolean
    Dim i As Integer
    
    ' 指定工作表对象
    Set wsRaw = ThisWorkbook.Worksheets("RAW")
    Set wsOutput = ThisWorkbook.Worksheets("Output")
    
    ' 清空Output表原有数据（保留表头行）
    wsOutput.Range("2:" & wsOutput.Rows.Count).ClearContents
    
    ' 获取原始数据的有效范围边界
    lastRowRaw = wsRaw.Cells(wsRaw.Rows.Count, "A").End(xlUp).Row
    lastColRaw = wsRaw.Cells(1, wsRaw.Columns.Count).End(xlToLeft).Column
    
    ' 初始化输出表起始行（默认第1行为表头）
    currentRowOutput = 2
    
    ' 遍历原始数据每一行（从第2行开始跳过表头）
    For currentRowRaw = 2 To lastRowRaw
        ' 提取当前行的发票明细（A-D列）
        Dim invoiceDetails As Variant
        invoiceDetails = wsRaw.Range("A" & currentRowRaw & ":D" & currentRowRaw).Value
        
        ' 从第10列（J列）开始，按每4列一组遍历项目
        itemColStart = 10
        Do While itemColStart <= lastColRaw
            itemColEnd = itemColStart + 3
            ' 检查当前项目组是否全零
            isItemValid = False
            For i = itemColStart To itemColEnd
                If wsRaw.Cells(currentRowRaw, i).Value <> 0 Then
                    isItemValid = True
                    Exit For
                End If
            Next i
            
            ' 若项目组非全零，写入输出表
            If isItemValid Then
                ' 粘贴发票明细
                wsOutput.Range("A" & currentRowOutput & ":D" & currentRowOutput).Value = invoiceDetails
                ' 粘贴项目数据
                wsOutput.Range("E" & currentRowOutput & ":H" & currentRowOutput).Value = _
                    wsRaw.Range(wsRaw.Cells(currentRowRaw, itemColStart), wsRaw.Cells(currentRowRaw, itemColEnd)).Value
                currentRowOutput = currentRowOutput + 1
            End If
            
            ' 切换到下一个项目组
            itemColStart = itemColEnd + 1
        Loop
    Next currentRowRaw
    
    MsgBox "拆分完成！结果已保存至Output工作表。", vbInformation
End Sub

使用步骤： #

1. 打开目标Excel文件，确保存在RAW原始数据工作表和Output结果工作表（若Output无表头，请手动添加对应列标题）。
2. 按下Alt + F11打开VBA编辑器。
3. 在左侧「工程资源管理器」中右键点击工作簿名称，选择「插入」→「模块」。
4. 将上述代码粘贴到新建模块中。
5. 点击工具栏绿色运行按钮，或按下F5执行脚本。

代码逻辑说明： #

• 自动识别原始数据的有效行数和列数，无需手动指定范围。
• 逐行提取发票明细，按每4列一组遍历项目数据。
• 跳过全零的项目组，仅保留有效项目。
• 将发票明细与有效项目组合后，逐行写入Output表。
• 执行完成后弹出提示告知结果。

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