重複多行中多次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