Excel VBA質問箱 IV

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

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


2912 / 13646 ツリー ←次へ | 前へ→

【65323】年、月から自動に一月分西暦でを入力させるには BUN 10/5/11(火) 17:23 質問[未読]
【65324】Re:年、月から自動に一月分西暦でを入力さ... Jaka 10/5/11(火) 17:37 発言[未読]
【65327】Re:年、月から自動に一月分西暦でを入力さ... teian 10/5/12(水) 9:25 回答[未読]
【65328】Re:年、月から自動に一月分西暦でを入力さ... teian 10/5/12(水) 9:34 発言[未読]

【65323】年、月から自動に一月分西暦でを入力させ...
質問  BUN  - 10/5/11(火) 17:23 -

引用なし
パスワード
    おせわなります

たとえば
A1に西暦
B1に月
を入力すると

C2から自動的に一ヶ月分の日付を入力させたいのですが
わかる方ご教授願います

【65324】Re:年、月から自動に一月分西暦でを入力...
発言  Jaka  - 10/5/11(火) 17:37 -

引用なし
パスワード
   C2
=DATE(A1,B1,1)

c3
=IF(C2="","",IF(MONTH(C2)<>MONTH(C2+1),"",C2+1))
c32までフィル。

【65327】Re:年、月から自動に一月分西暦でを入力...
回答  teian  - 10/5/12(水) 9:25 -

引用なし
パスワード
   ▼BUN さん:
> おせわなります
>
>たとえば
>A1に西暦
>B1に月
>を入力すると
>
>C2から自動的に一ヶ月分の日付を入力させたいのですが
>わかる方ご教授願います

VBAで実装したいんでいいですよね。
即座に処理させるんであれば、
当該シートのChangeイベントプロシージャにコードを書くことになります。
多少の例外を考慮すると、
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range
  Dim d As Date
  
  Set r = Me.Range("A1:B1")
  If Intersect(Target, r) Is Nothing Then Exit Sub
  If IsEmpty(r(1)) Or IsEmpty(r(2)) Then Exit Sub
  Application.EnableEvents = False
  With Me.Range("C2")
    .Resize(31).ClearContents
    On Error GoTo ErrHndl
    d = DateSerial(r(1).Value, r(2).Value, 1)
    On Error GoTo 0
    With .Resize(Day(DateAdd("m", 1, d) - 1))
      .Item(1) = d
      .DataSeries
    End With
  End With
  Application.EnableEvents = True
  Exit Sub
ErrHndl:
  Application.EnableEvents = True
End Sub
てな感じでしょうか?
なお、B1セルに月としてはありえないような13以上が入ったら駄目とかであれば、
そういう類の対策は別途対応が必要です。

【65328】Re:年、月から自動に一月分西暦でを入力...
発言  teian  - 10/5/12(水) 9:34 -

引用なし
パスワード
   なお、
>C2から自動的に一ヶ月分の日付を入力させたいのですが
を縦方向(行)に一覧すると解釈した例を提示しましたが、
もし横方向(列)であるならば、
C2セルからのResizeプロパティの方向を変更してください。
> .Resize(31).ClearContents を
 .Resize(, 31).ClearContents へ

> With .Resize(Day(DateAdd("m", 1, d) - 1)) を
 With .Resize(, Day(DateAdd("m", 1, d) - 1)) へ
です。

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