使用计算在Excel VBA中多次重复多行

Question

我有一张带有数据的Excel表格，如下图所示：

我需要将其列出如下：

有人可以帮我为这个请求提供一个excel宏，因为有很多这样的行，我对excel宏不太熟练吗？

Answer 1

在我的测试中，这完全符合您的要求。

您需要重命名表格，具体取决于原始数据表名称的工作表名称和输出/结果表名称。

 Option Explicit

 Sub splittinghours()

      Dim DataSheet As Worksheet
      Dim ResultSheet As Worksheet
      Set DataSheet = ThisWorkbook.Sheets("Sheet1")
      Set ResultSheet = ThisWorkbook.Sheets("Sheet2")

      Dim DataSheetLastRow As Long
      With DataSheet
          DataSheetLastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
      End With

      Dim ActualWarehouse As String
      Dim ActualDate As String
      Dim InTime As Date
      Dim OutTime As Date
      Dim Duration As Long
      Dim CurrentRow As Long
      Dim DurationCounter As Long
      Dim SegmentedDuration As Date
      Dim ResultSheetNextFreeLine As Long

      ResultSheet.Range(Cells(2, "A"), Cells(ResultSheet.Rows.Count, ResultSheet.Columns.Count)).Delete

      ResultSheetNextFreeLine = 0

      For CurrentRow = 2 To DataSheetLastRow

           ActualWarehouse = DataSheet.Cells(CurrentRow, "A").Value
           ActualDate = DataSheet.Cells(CurrentRow, "B").Value
           InTime = DataSheet.Cells(CurrentRow, "C").Value
           OutTime = DataSheet.Cells(CurrentRow, "D").Value
           Duration = DataSheet.Cells(CurrentRow, "E").Value
           SegmentedDuration = (OutTime - InTime) / Duration

           ResultSheetNextFreeLine = ResultSheet.Cells(ResultSheet.Rows.Count, "A").End(xlUp).Row

           For DurationCounter = 1 To Duration

                With ResultSheet

                    .Cells(ResultSheetNextFreeLine + DurationCounter, "A").Value = ActualWarehouse
                    .Cells(ResultSheetNextFreeLine + DurationCounter, "B").Value = ActualDate
                    .Cells(ResultSheetNextFreeLine + DurationCounter, "C").Value = InTime
                    .Cells(ResultSheetNextFreeLine + DurationCounter, "D").Value = InTime + SegmentedDuration
                     InTime = InTime + SegmentedDuration

                End With

           Next DurationCounter

      Next CurrentRow

 End Sub