Excelで生産予定・実績表を作ってみよう

'機種マスターの機種名をセットする
Private Sub ExMasterSet()
    Dim lmaxrow As Long
    Dim lrow As Long
    Dim i As Long
    Dim destrow As Long
    Dim destcol As Long
    Dim lastday As Integer
        
    '最終日を取得
    lastday = MonthLastDay(Range("L9"), Range("L10"))
    'セット先
    destrow = Range(Range("L4")).Row
    destcol = Range(Range("L4")).Column
    '項目名をセット
    Worksheets(Sheets.Count).Cells(destrow, destcol) = "コード"
    Worksheets(Sheets.Count).Cells(destrow, destcol + 1) = "機種名"
    Worksheets(Sheets.Count).Cells(destrow - 1, destcol + 3) = "予定数"
    Worksheets(Sheets.Count).Cells(destrow, destcol + 3) = "実績計"
    Worksheets(Sheets.Count).Cells(destrow - 1, destcol + 4) = "開始日"
    Worksheets(Sheets.Count).Cells(destrow, destcol + 4) = "実績％"
    'マークの最下行
    lmaxrow = Worksheets("機種マスター").Range("B65536").End(xlUp).Row
    destrow = destrow + 1
    For i = 5 To lmaxrow
        'マークのチェック
        If Worksheets("機種マスター").Cells(i, 2) <> "" Then
            'マークがあればコードと機種名をセットする
            Worksheets(Sheets.Count).Cells(destrow, destcol) = Worksheets("機種マスター").Cells(i, 3)
            Worksheets(Sheets.Count).Cells(destrow, destcol + 1) = Worksheets("機種マスター").Cells(i, 4)
            Worksheets(Sheets.Count).Cells(destrow, destcol + 2) = "予定"
            Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 2) = "実績"
            '実績合計　関数のセット
            Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 3).FormulaLocal = ""_
            =SUM(" & Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 5).Address & ":" & _
            Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 4 + lastday).Address & ")"
            '実績合計　達成率のセット
            Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 4).FormulaLocal = ""_
            =IF(" & Worksheets(Sheets.Count).Cells(destrow, destcol + 3).Address & "<>0," & _
            Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 3).Address & "/" & _
            Worksheets(Sheets.Count).Cells(destrow, destcol + 3).Address & ","""")"
            'パーセントに書式セット　小数点以下一桁
            Worksheets(Sheets.Count).Cells(destrow + 1, destcol + 4).NumberFormat = "0.0%"
            destrow = destrow + 2
        End If
    Next
End Sub