シートを作成しながら、累計を計算
Sub Create() Dim DataRange As Range Dim DataArr As Variant, Row As Variant Dim StartTime As Date, EndTime As Date Dim Cumulative As Double Set DataRange = Worksheets("form").Cells(5, 9).CurrentRegion IsErr = CheckData(DataRange) If IsErr = True Then MsgBox "入力値にエラーが存在します。" Exit Sub End If DataArr = DataRange For Row = 1 To UBound(DataArr, 1) StartTime = DataArr(Row, 1) EndTime = DataArr(Row, 2) Worksheets("format").Copy After:=Worksheets(Worksheets.Count) With ActiveSheet .Name = Format(StartTime, "yyyymmdd") .Cells(5, 2) = Format(StartTime, "Long Date") .Cells(7, 2) = Format(StartTime, "m") .Cells(7, 3) = Format(StartTime, "d") .Cells(7, 4) = Format(StartTime, "h") .Cells(7, 5) = Format(StartTime, "n") .Cells(10, 2) = Format(EndTime, "m") .Cells(10, 3) = Format(EndTime, "d") .Cells(10, 4) = Format(EndTime, "h") .Cells(10, 5) = Format(EndTime, "n") mindiff = DateDiff("n", StartTime, EndTime) workTime = WorksheetFunction.Ceiling(mindiff / 60, 1 / 2) .Cells(13, 2) = workTime Cumulative = Cumulative + workTime .Cells(13, 3) = Cumulative End With Next End Sub Private Function CheckData(DataRange As Range) Dim ErrArr As Variant Dim StartCell As Range Dim EndCell As Range DataRange.Interior.ColorIndex = 0 CheckData = False For Row = 1 To DataRange.Rows.Count Set StartCell = DataRange.Cells(Row, 1) Set EndCell = DataRange.Cells(Row, 2) If IsDate(StartCell.Value) = False _ Or IsDate(EndCell.Value) = False Then StartCell.Interior.Color = RGB(255, 150, 150) EndCell.Interior.Color = RGB(255, 150, 150) CheckData = True End If Next End Function
以下、メモ書き
Set DataRange = Worksheets("form").Cells(5, 9).CurrentRegion
CurrentRegionで空行までの範囲を取得(Range)