是的，仅使用公式即可完成：
起始数据：

输出数据：

...
首先，我从3个辅助列开始：

A）#s（这可以代替ROW（），但我发现这更容易。1到1000，但请随意继续至少比您的最大预期数据集大5倍。
B）计算RAW工作表上“过帐状态”列右侧的非空单元格的数量
C）这就不那么清楚了。第一个单元格（C2）必须是数字1，然后后面的每个单元格，一直到第1000行，都有这个公式：
=IF(COUNTIF($C$1:C2,C2)=INDEX(B:B,MATCH(C2,A:A,0)),C2+1,C2)

接下来，我们从重复常规数据集开始：
=IF($C2<INDEX($A:$A,MATCH(0,$B:$B,0)),INDEX(RAW!A:A,$C2+1),"")
x1c4d 1x指令集
(this整个蓝色部分的公式完全相同：D2：K1000）
现在！真正有趣的部分：
在发票列中：
=IF($C3<INDEX($A:$A,MATCH(0,$B:$B,0)),OFFSET(RAW!$I$1,$C3,((COUNTIF($C$1:$C3,$C3)-1)*4),1,4),"")

确保所有的东西都填到了第1000行（或者你选择的任何一行），鲍勃就是你的阿姨！
注意：

• 我假设RAW工作表上的A列（计数）是您添加的。如果不是，您需要注意复制它，或者调整所有公式从一个单元格向右拉。
• 如果你有任何问题，请告诉我。

转换数据（VBA）

Option Explicit

Sub TransformData()
    
    ' Define constants.
    
    Const SRC_NAME As String = "RAW"
    Const SRC_FIRST_CELL As String = "A3"
    Const SRC_REPEAT_COLUMNS As Long = 9
    Const SRC_CHANGE_COLUMNS As Long = 4
    
    Const DST_NAME As String = "Output"
    Const DST_FIRST_CELL As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the Source range.
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(SRC_NAME)
    Dim sfCell As Range: Set sfCell = sws.Range(SRC_FIRST_CELL)
    
    Dim srg As Range, srOffset As Long, srCount As Long, scCount As Long
    
    With sws.UsedRange
        scCount = .Columns.Count
        srOffset = sfCell.Row - 1
        srCount = .Rows.Count - srOffset
        If srCount < 1 Then
            MsgBox "No data in the Source worksheet.", vbExclamation
            Exit Sub
        End If
        Set srg = .Resize(srCount).Offset(srOffset)
    End With
    
    ' Write the values from the Source range to the Source array.
    
    Dim sData() As Variant: sData = srg.Value
    
    ' Define the Destination array.
    
    Dim scaCount As Long
    scaCount = (scCount - SRC_REPEAT_COLUMNS) / SRC_CHANGE_COLUMNS
    
    Dim drCount As Long: drCount = scaCount * scCount ' could be to many
    Dim dcCount As Long: dcCount = SRC_REPEAT_COLUMNS + SRC_CHANGE_COLUMNS
    
    Dim dData() As Variant: ReDim dData(1 To drCount, 1 To dcCount)
    
    ' Transform the data from the Source array
    ' into the Destination array.
    
    Dim sr As Long, sc As Long, scFirst As Long, scLast As Long, sca As Long
    Dim dr As Long, dc As Long
    
    For sr = 1 To srCount
        For sca = 1 To scaCount
            ' Determine the Source Change columns.
            scFirst = 1 + SRC_REPEAT_COLUMNS + (sca - 1) * SRC_CHANGE_COLUMNS
            scLast = scFirst + SRC_CHANGE_COLUMNS - 1
            ' Check if the Source Area is not blank.
            For sc = scFirst To scLast
                If Len(CStr(sData(sr, sc))) > 0 Then Exit For
            Next sc
            ' Write the Source data.
            If sc <= scLast Then ' Source Area is not blank
                dr = dr + 1
                For sc = 1 To SRC_REPEAT_COLUMNS
                    dData(dr, sc) = sData(sr, sc)
                Next sc
                dc = SRC_REPEAT_COLUMNS
                For sc = scFirst To scLast
                    dc = dc + 1
                    dData(dr, dc) = sData(sr, sc)
                Next sc
            'Else ' Source Area is blank; do nothing
            End If
        Next sca
    Next sr
    
    If dr = 0 Then
        MsgBox "No data found.", vbExclamation
        Exit Sub
    End If
    
    Erase sData
    
    ' Reference the Destination range.
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(DST_NAME)
     
    Dim dfCell As Range: Set dfCell = dws.Range(DST_FIRST_CELL)
    Dim drg As Range: Set drg = dfCell.Resize(dr, dcCount)
    
    ' Write the values from the Destination array to the Destination range.
    
    drg.Value = dData
    drg.Resize(dws.Rows.Count - drg.Row - dr + 1).Offset(dr).Clear
    
    ' Inform.
    
    MsgBox "Data transformed.", vbInformation
    
End Sub