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) = "1日の数量"
    Worksheets(Sheets.Count).Cells(destrow, destcol + 4) = "実績％"
    Worksheets(Sheets.Count).Cells(destrow - 1, destcol + 5) = "開始日"
    
    
    'マークの最下行
    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


'日付をセット
Private Sub ExDaySet()
    Dim i As Integer
    Dim s As String
    Dim saijitu As String
    Dim lastday As Integer
    Dim tdate As Date
    Dim ncol As Integer
    Dim nrow As Integer
    
    tdate = Format(Range("L9") & "/" & Range("L10") & "/1", "yyyy/mm/dd")
    
    Worksheets(Sheets.Count).Select
    Worksheets(Sheets.Count).Range(Range("L4")).Select
    ActiveCell.Offset(columnOffset:=6).Activate
    
    lastday = MonthLastDay(Range("L9"), Range("L10"))
    For i = 1 To lastday
        '国民の祝日か判定
        saijitu = GetSaijituName(tdate)
        If saijitu <> "" Then
            'フォント色をセット
            ActiveCell.Font.Color = Range("L8").Interior.Color
            '祭日名のコメントを追加
            ActiveCell.AddComment saijitu
            ActiveCell.Comment.Visible = True
            '追加したコメントを選択
            Selection.Comment.Shape.Select True
            '自動サイズにする
            Selection.AutoSize = True
            ' コメントを非表示する
            ActiveCell.Comment.Visible = False
        Else
            '曜日の取得
            s = GetWeekDay(tdate)
            '文字のフォント色をセット
            If s = "日" Then
                ActiveCell.Font.Color = Range("L7").Interior.Color
            ElseIf s = "土" Then
                ActiveCell.Font.Color = Range("L6").Interior.Color
            Else
                ActiveCell.Font.Color = Range("L5").Interior.Color
            End If
        End If
        '中央配置
        ActiveCell.HorizontalAlignment = xlHAlignCenter
        ActiveCell = i & "(" & s & ")"
        tdate = tdate + 1
        
        ActiveCell.Offset(columnOffset:=1).Activate
    Next
    Worksheets(Sheets.Count).Range(Range("L4")).Select
End Sub