使用VBA插入整个行使用特定的单元格值

我有这种格式的问题

from hrs to hrs quantum rate 12:00:00 6:00:00 100 1.8 12:00:00 5:00:00 125 1.6 

我想要像给定的格式这个数据

 from hrs to hrs quantum rate 12:00:00 6:00:00 -50 1800.00 12:00:00 6:00:00 -50 1800.00 12:00:00 5:00:00 -50 1600.00 12:00:00 5:00:00 -50 1600.00 12:00:00 5:00:00 -25 1600.00 

我正在使用下面的代码:

 Option Explicit Sub main() Dim data As Variant Dim iData As Long, datum As Long, iRow As Long With Range("A1", Cells(Rows.Count, 1).End(xlUp)) data = .Resize(, 4).Value iData = LBound(data) Do datum = data(iData, UBound(data, 2) - 1) Do While datum > 0 iRow = iRow + 1 .Cells(iRow).Resize(, 4) = Application.Index(data, iData, 0) .Cells(iRow, UBound(data, 2) - 1).Value = WorksheetFunction.Min(50, datum) datum = datum - 50 Loop iData = iData + 1 Loop While iData <= UBound(data) .Resize(1).Copy .Resize(iRow).PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End Sub 

这里是:

 Option Explicit Sub main() Dim data As Variant Dim iData As Long, datum As Long, iRow As Long With Range("A1", Cells(Rows.Count, 1).End(xlUp)) data = .Resize(, 4).Value iData = LBound(data) Do datum = data(iData, UBound(data, 2) - 1) Do While datum > 0 iRow = iRow + 1 .Cells(iRow).Resize(, 4) = Application.Index(data, iData, 0) .Cells(iRow).Offset(, 3).Value = .Cells(iRow).Offset(, 3).Value * 1000 .Cells(iRow, UBound(data, 2) - 1).Value = -WorksheetFunction.Min(50, datum) datum = datum - 50 Loop iData = iData + 1 Loop While iData <= UBound(data) .Resize(1, 4).Copy .Resize(iRow, 4).PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End Sub