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

Step 4 日付、祝日をセットする

メニューに戻る

スポンサードリンク



シートコード

下記に変更してください。

'設定値のチェック
Private Function SetDataCheck() As Boolean
    SetDataCheck = False
    
    '開始セル位置
    If Range("L4") = "" Then
        Range("L4").Select
        Beep
        MsgBox "開始セル位置を入力してください。", , "生産予定実績表"
        Exit Function
    End If
    
    If Range(Range("L4")).Column < 2 Then
        Range("L4").Select
        Beep
        MsgBox "開始セル位置の列はB以降にしてください。", , "生産予定実績表"
        Exit Function
    End If
    
    '作成年のチェック
    If Range("L9") < 2000 Or Range("L9") > 2100 Then
        Range("L9").Select
        Beep
        MsgBox "作成年を2000〜2100の範囲で入力してください。", , "生産予定実績表"
        Exit Function
    End If
    
    '作成月のチェック
    If Range("L10") < 1 Or Range("L10") > 12 Then
        Range("L10").Select
        Beep
        MsgBox "作成月を1〜12の範囲で入力してください。", , "生産予定実績表"
        Exit Function
    End If
    
    SetDataCheck = True
End Function

Private Sub ExNewSheetMake()
    Dim SheetName As String
    
    SheetName = ExNewSheetName
    'シートの追加
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    '名前の変更
    ActiveWorkbook.ActiveSheet.Name = SheetName
End Sub

Private Sub CommandButton1_Click()
    Range("L12").Select
    If Not SetDataCheck Then
        Exit Sub
    End If
        
    ExNewSheetMake
    
    Worksheets("機種マスター").Select
    Range("L12").Select
    
    DaySet
End Sub

下記のコードを追加してください。

'日付をセット
Private Sub DaySet()
    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
    
    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

スポンサードリンク



標準コード

Option Explicit

'日付の曜日を取得
Public Function GetWeekDay(tdate As Date) As String
    Select Case Weekday(tdate)
        Case 1
            GetWeekDay = "日"
        Case 2
            GetWeekDay = "月"
        Case 3
            GetWeekDay = "火"
        Case 4
            GetWeekDay = "水"
        Case 5
            GetWeekDay = "木"
        Case 6
            GetWeekDay = "金"
        Case 7
            GetWeekDay = "土"
    End Select
End Function

'国民の祝日か判定
Public Function GetSaijituName(tSrcDate As Date) As String
    Dim SaiName As String
    Dim tdate As Date
    
    SaiName = ""
    
    Select Case CLng(Format(tSrcDate, "mmdd"))
        Case 101    '1948年-元日制定
            If tSrcDate >= #7/20/1948# Then
                SaiName = "元日"
            End If
        Case 108 To 114     '2000年1月第2月曜-成人の日
            If tSrcDate >= #1/1/2000# Then
                If Weekday(tSrcDate, vbSunday) = vbMonday Then
                    SaiName = "成人の日"
                End If
            End If
        Case 115    '1948年〜1999年-成人の日
            If tSrcDate >= #7/20/1948# And tSrcDate < #1/1/2000# Then
                SaiName = "成人の日"
            End If
        Case 116    '1948年〜1999年-成人の日 振替休日
            If tSrcDate >= #7/20/1948# And tSrcDate < #1/1/2000# _
                And Weekday(tSrcDate, vbSunday) = vbMonday Then
                SaiName = "振替休日"
            End If
        Case 211    '1967年-建国記念の日
            If tSrcDate >= #6/25/1966# Then
                SaiName = "建国記念の日"
            End If
        Case 224    '1989/2/24-大喪の礼
            If tSrcDate = #2/24/1989# Then
                SaiName = "大喪の礼"
            End If
        Case 319 To 322     '1948年-春分の日    1973年-振替休日
            If tSrcDate >= #7/20/1948# Then
                tdate = HaruAkiDay(Year(tSrcDate), 0)
                If tdate = tSrcDate Then
                    SaiName = "春分の日"
                ElseIf tSrcDate >= #4/12/1973# And _
                    (Weekday(tSrcDate, vbSunday) = vbMonday) And _
                        (tdate + 1 = tSrcDate) Then
                    SaiName = "振替休日"
                End If
            End If
        Case 429    '1948年-天皇誕生日,1989年-みどりの日
            If tSrcDate >= #2/17/1989# Then
                SaiName = "みどりの日"
            ElseIf tSrcDate >= #7/20/1948# Then
                SaiName = "天皇誕生日"
            End If
        Case 503    '1948年-憲法記念日
            If tSrcDate >= #7/20/1948# Then
                SaiName = "憲法記念日"
            End If
        Case 504    '1973年-振替休日,1985年-国民の休日
            Select Case Weekday(tSrcDate, vbSunday)
                Case vbSunday
                Case vbMonday
                    If tSrcDate >= #4/12/1973# Then
                        SaiName = "振替休日"
                    End If
                Case Else
                    If tSrcDate >= #12/27/1985# Then
                        SaiName = "国民の休日"
                    End If
                End Select
        Case 505    '1948年-憲法記念日
            If tSrcDate >= #7/20/1948# Then
                SaiName = "こどもの日"
            End If
        Case 715 To 721 '1996年-海の日,2003年第3月曜
            If tSrcDate >= #1/1/2003# Then
                If Weekday(tSrcDate, vbSunday) = vbMonday Then
                    SaiName = "海の日"
                End If
            ElseIf tSrcDate >= #1/1/1996# And Day(tSrcDate) = 20 Then
                SaiName = "海の日"
            End If
        Case 915 To 921     '1996年-敬老の日,2003年第3月曜
            If tSrcDate >= #6/25/1966# And tSrcDate < #1/1/2003# Then
                SaiName = "敬老の日"
            Else
                If Weekday(tSrcDate, vbSunday) = vbMonday Then
                    SaiName = "敬老の日"
                End If
            End If
        Case 921 To 924     '1948年-秋分の日,1973年-振替休日
            If tSrcDate >= #7/20/1948# Then
                tdate = HaruAkiDay(Year(tSrcDate), 1)
                If tdate = tSrcDate Then
                    SaiName = "秋分の日"
                ElseIf tSrcDate >= #4/12/1973# And _
                    (Weekday(tSrcDate, vbSunday) = vbMonday) And _
                        (tdate + 1 = tSrcDate) Then
                    SaiName = "振替休日"
                End If
            End If
        Case 1008 To 1014   '1966年-体育の日,2000年第2月曜
            If tSrcDate >= #1/1/2000# Then
                If Weekday(tSrcDate, vbSunday) = vbMonday Then
                    SaiName = "体育の日"
                End If
            '平成10年法律141号-[体育の日]10月10日→10月第2月曜:平成12年1月1日より
            ElseIf tSrcDate >= #6/5/1966# Then
                If Day(tSrcDate) = 10 Then
                    SaiName = "体育の日"
                ElseIf Day(tSrcDate) = 11 Then  '1973年-振替休日
                        If tSrcDate >= #4/12/1973# And _
                            Weekday(tSrcDate, vbMonday) = vbMonday Then
                            SaiName = "体育の日"
                        End If
                End If
            End If
        Case 1103   '1948年-文化の日
            If tSrcDate >= #7/20/1948# Then
                SaiName = "文化の日"
            End If
        Case 1123   '1948年-勤労感謝の日
            If tSrcDate >= #7/20/1948# Then
                SaiName = "勤労感謝の日"
            End If
        Case 1223   '1989年-天皇誕生日
            If tSrcDate >= #2/17/1989# Then
                SaiName = "天皇誕生日"
            End If
        Case 102, 212, 430, 506, 721, 916, 1104, 1124, 1224     '1973年-振替休日
            If tSrcDate >= #4/12/1973# And Weekday(tSrcDate, vbSunday) = vbMonday Then
                SaiName = "振替休日"
            End If
        Case Else
            SaiName = ""
    End Select
    
    GetSaijituName = SaiName
End Function

'春分の日,秋分の日
Public Function HaruAkiDay(ByVal yy As Integer, haru As Integer) As Date
    Dim vv As Variant
    Dim yr As Variant
    Dim mo As Integer
    Dim dy As Integer
    
    If 1980 <= yy And yy <= 2099 Then
        yr = CDec(yy - 1980)
        If haru = 0 Then   '春分の日
            mo = 3
            vv = CDec("20.8431")
        Else    '秋分の日
            mo = 9
            vv = CDec("23.2488")
        End If
        dy = CLng(Int(vv + CDec(0.242194) * yr - Int(yr / CDec(4))))
        HaruAkiDay = DateSerial(yy, mo, dy)
    Else
        HaruAkiDay = CDate(0)
    End If
End Function

'月の末日を取得
Public Function MonthLastDay(yy As Integer, mm As Integer) As Integer
    Dim i As Integer
    Dim tdate As Date
    
    tdate = Format(yy & "/" & mm & "/1", "yyyy/mm/dd")
    i = 28
    Do
        i = i + 1
    Loop Until Day(tdate + i - 1) = 1
    MonthLastDay = i - 1
End Function

シート画面

「作成開始ボタン」をクリックすると、「日付(曜日)」の形式でセットされます。
土曜、日曜、祭日の色は指定色になります。
祭日は下図のように祝日名をコメントで表示します。


スポンサードリンク





メニューに戻る

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


関連コンテンツ

Copyright (c) Excel-Excel ! All rights reserved