Option Explicit
Private Sub test()
Dim ws As Worksheet
Dim StartDate As Date
Dim EndDate As Date
StartDate = "2025/1/1"
EndDate = "2025/12/31"
Call CreateCalendar(StartDate, EndDate, WsTask)
End Sub
Function WsTask() As Worksheet
Set WsTask = ThisWorkbook.Sheets("Sheet1") ' シート1を指定
End Function
Function CreateCalendar(StartDate As Date, EndDate As Date, ws As Worksheet)
Dim currentDate As Date
Dim col As Integer
Dim StartRow As Integer
Dim EndCol As Long
StartRow = 2
col = 18 ' 12列から開始
'日付範囲をクリア
EndCol = Cells(StartRow, Columns.Count).End(xlToLeft).Column
ws.Range(ws.Cells(StartRow, col), ws.Cells(StartRow + 3, EndCol)).ClearContents
' ループでカレンダーを作成
For currentDate = StartDate To EndDate
ws.Cells(StartRow, col).Value = Year(currentDate) ' 年
ws.Cells(StartRow + 1, col).Value = Month(currentDate) ' 月
ws.Cells(StartRow + 2, col).Value = Day(currentDate) ' 日
ws.Cells(StartRow + 3, col).Value = Format(currentDate, "aaa") ' 曜日(日本語)
col = col + 1 ' 次の列へ
Next currentDate
' 列の自動調整
ws.Range(ws.Cells(StartRow, col), ws.Cells(StartRow + 3, EndCol)).EntireColumn.AutoFit
End Function
Sub CalendarColor()
With WsTask
For currentDate = StartDate To EndDate
If Format(currentDate, "aaa") = "土" Or Format(currentDate, "aaa") = "日" Then
ws.Columns(col).Interior.Color = 灰色
End If
Next
End With
End Sub
コメント