Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3380 / 13644 ツリー ←次へ | 前へ→

【62595】Calendarの制作に関して yamamiti 09/8/4(火) 20:02 質問[未読]
【62596】Re:Calendarの制作に関して Hirofumi 09/8/5(水) 7:04 回答[未読]
【62602】Re:Calendarの制作に関して yamamiti 09/8/5(水) 21:00 お礼[未読]

【62595】Calendarの制作に関して
質問  yamamiti  - 09/8/4(火) 20:02 -

引用なし
パスワード
   エクセルの天地に2月分のカレンダーを作成したく
コードを作成しました。2ケ月単位に更新して印刷
したく考えています。
とりあえず、1ヶ月分(例えば9月分…E1に9/1と入力して)
のコードを作成しました。
このコードを動作させると一応、曜日別に日にちが入ります。
しかし、日にちの下にメモ(当番)を書きたく一行空けたいのですが
Loopの中で空けるコードを作成したいのですが、その
方法を教えてください。
現在のコードですと、上と下の月別カレンダーの位置が、
どんどん離れて行き、印刷に耐えません。
よろしく、お願いします。

Sub test()

Dim 日付 As Date
Dim 今月 As Integer
Dim 曜日数 As Integer
Dim 行 As Integer

 日付 = Range("E1").Value
 今月 = Month(日付)
 曜日数 = Weekday(日付)

Range("B4:H14").ClearContents
 
Do While 今月 = Month(日付)
   Range("B4:H9").Cells(Day(日付) + 曜日数 - 1).Value = Day(日付)
   日付 = 日付 + 1  
Loop
      '  '←ここから4行をLoopの中に組み込みたいのですが
For 行 = 5 To 13 Step 2 
  Rows(行).Insert Shift:=xlDown
Next
  Rows("4:15").RowHeight = 40
  
End Sub

【62596】Re:Calendarの制作に関して
回答  Hirofumi  - 09/8/5(水) 7:04 -

引用なし
パスワード
   こんなのでは

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

【62602】Re:Calendarの制作に関して
お礼  yamamiti  - 09/8/5(水) 21:00 -

引用なし
パスワード
   ▼Hirofumi さん:

有難うございました。
丁寧にコードを書いていただき感謝しています。
よく理解できました。
今後ともよろしくご指導のほどお願い申し上げます。

3380 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free