Excel VBA質問箱 IV

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

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


52237 / 76732 ←次へ | 前へ→

【29336】Re:シートチェンジによる日付の自動生成
回答  Statis  - 05/10/1(土) 16:06 -

引用なし
パスワード
   こんにちは

これでどうかな?


Private Sub Worksheet_Change(ByVal Target As Range)
 Dim themonth As Integer
 Dim theyear As Integer
 Dim days As Integer
With Target
  If IsEmpty(.Value) Then Exit Sub
  If Not IsNumeric(.Value) Then Exit Sub
  If .Count > 1 Then Exit Sub
  '入力セルがA1とB1の場合のみ処理する
  Application.EnableEvents = False
  If .Address(0, 0) = "A1" Or .Address(0, 0) = "B1" Then
   'A1とB1に数値が入力してあれば、処理する。
   If Range("A1").Value <> "" And Range("B1").Value <> "" And _
     IsNumeric(Range("A1").Value) And IsNumeric(Range("B1").Value) Then
     '前回の値をクリアする。
     Range("A4:A35").ClearContents
     '年のセル
     theyear = Range("A1").Value
     '月のセル
     themonth = WorksheetFunction.RoundDown(Range("B1").Value, 0)
     '月の値が1〜12かをチェック(小数点だったときも反応してしまうが・・・)
     If themonth >= 1 And themonth <= 12 Then
      With Range("A4")
        '1ヶ月分の日付を生成する。
         For days = 1 To Day(DateSerial(theyear, themonth + 1, 1) - 1)
           .Offset(days - 1).Value = DateSerial(theyear, themonth, days)
         Next
      End With
     Else
       MsgBox "月の値は、1〜12を入力してください。"
       Range("B1").Select
     End If
    End If
   End If
End With
Application.EnableEvents = True
End Sub
0 hits

【29334】シートチェンジによる日付の自動生成 初心者 05/10/1(土) 13:43 質問
【29336】Re:シートチェンジによる日付の自動生成 Statis 05/10/1(土) 16:06 回答

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