stgtの日記

思い付き、気になったことを覚えておけない。

シートを作成しながら、累計を計算

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) f:id:stgt:20190730071245p:plain