下面是一个例程，它将输入表复制到一个数组，然后从输入构建一个输出数组（在内存中），然后将输出数组转储回工作表。
注：它忽略“单次/多次”列，而仅使用最后一列中的值来确定重复输出的次数。

Sub RepeatData()

    'Declarations
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim m As Long, n As Long, o As Long, r As Long, c As Long
    
    With ActiveSheet
    
        'Find Last Row of table
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        'Find Last Column of table
        LastColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
        
        'Copy table to array
        Dim ArrInput
        ArrInput = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(LastRow, LastColumn)).Value
        
        'sum up multiples (total of last column in table) so we know how big the output array needs to be
        OutputRows = 1 + Application.WorksheetFunction.Sum(Cells(2, LastColumn).Resize(UBound(ArrInput) - 1, 1))
        
        'Create output array for filling
        ReDim ArrOutput(1 To OutputRows, 1 To LastColumn)
        
        'Copy data across
        o = 1   ' start outputting to index 1 of ArrOutput
        
        For r = 1 To LastRow
            
            If r = 1 Then                   ' if on header row
                m = 1                       ' set repeat to once (set m to 1)
            Else                            ' if not on header row
                m = ArrInput(r, LastColumn) ' set repeat to value in last column
            End If
            
            For n = 1 To m                  ' loop to repeat
                For c = 1 To LastColumn     ' cycle across columns
                    ArrOutput(o, c) = ArrInput(r, c)    'copy value
                Next
                o = o + 1                   ' increment output index
            Next
        Next

    End With
    
    'Write output array to sheet, 5 rows below the end of the input table
    ActiveSheet.Cells(LastRow + 5, 1).Resize(UBound(ArrOutput), UBound(ArrOutput, 2)).Value = ArrOutput

End Sub