| 
    
     |  | こんなのでは 
 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
 
 |  |