|
こんなのでは
Option Explicit
Sub test_2()
Const clngNumb As Long = 7
Const clngRPitch As Long = 2
Dim 日付 As Variant
Dim 今月 As Long
Dim 曜日数 As Long
Dim 行 As Long
Dim 列 As Long
Dim 開始 As Long
日付 = Range("E1").Value
If Not IsDate(日付) Then
Exit Sub
Else
日付 = DateSerial(Year(日付), Month(日付), 1)
開始 = 日付
End If
今月 = Month(日付)
曜日数 = Weekday(日付) - 1
Range("B4:H14").ClearContents
Do While 今月 = Month(日付)
行 = ((日付 - 開始 + 曜日数) \ clngNumb) * clngRPitch + 1
列 = ((日付 - 開始 + 曜日数) Mod clngNumb) + 1
Range("B4:H9").Cells(行, 列).Value = Day(日付)
日付 = 日付 + 1
Loop
End Sub
|
|