こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

セル空白時に月を変更した時の累計使用日数VBA

お世話になります、エクセルVBA初心者の者です。

'*******************************************************************************
' セル変更した時のイベント
'*******************************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myNum As Long
If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Target
If .Column = 3 Then
myNum = WorksheetFunction.Max(Range("B9:B39"))
myDate = Range("C1").Value
Range("A9:A39").ClearContents
If IsDate(.Value) Then
' ----------A列に日にちを入力----------
For i = 1 To 31
If Month(myDate + i - 1) = Month(.Value) Then
Cells(i + 8, "A").Value = Day(myDate + i - 1)
Else
Cells(i + 8, "A").Value = ""
End If
Next i
' ----------B列の空白条件----------
If Range("B39").Value = "" Or Range("B38").Value = "" Or Range("B37").Value = "" Or Range("B36").Value = "" Then
Range("B9:B39").ClearContents
Application.EnableEvents = True
End
End If
' ----------B列に連続値の入力----------
For i = 9 To 39
If Cells(i, "A").Value = "" Then
Cells(i, "B").Value = ""
Else
Cells(i, "B") = myNum + i - 8
End If
Next i
End If
Else
End With
Application.EnableEvents = True
End Sub

内容はC1には年月(2013年12月)を表示させています。

そして、B9~B39には累計使用日数を表示するVBAを組んでいます。

B9~B39間に適当な数字を入力すると、連続データの数字が入力されるようになります。

そして、C1セルの日付を変更しても連続データが継続して表示されるVBAです。

B39が空白表示の場合(小月ならB38で2月ならB36かB37)でC1セルの年月を変更した場合、連続データを表示させず空白セルを表示させるVBAを組んだつもりです。

しかし、上手く作動しません。もうお手上げです。どこがおかしいのでしょうか?ご教授宜しくお願いします。

投稿日時 - 2013-12-18 16:23:20

QNo.8391441

すぐに回答ほしいです

質問者が選んだベストアンサー

No,1です。
具体的に何がしたいのかまだ見えてきませんが・・・
とりあえずA・B列とC1セルだけのChangeイベントにしています。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myNum As Long, myMax As Long
Dim myFlg As Boolean '←追加
If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub
'最初にA列とB列の最終行の違いを取得しておく
If Cells(Rows.Count, "A").End(xlUp).Row > Cells(Rows.Count, "B").End(xlUp).Row Then
myFlg = True '←「TRUE」の場合はB列消去あり
End If
Application.EnableEvents = False
If IsDate(Range("C1")) Then
myMax = Day(DateSerial(Year(Range("C1")), Month(Range("C1")) + 1, 1) - 1)
End If
With Target
If .Column = 3 Then
Range("A9:A39").ClearContents
For i = 1 To myMax
Cells(i + 8, "A") = i
Next i
If myFlg = False Then '←「FALSE」(B列消去なし)の場合は・・・
myNum = Cells(40, "B").End(xlUp)
Range("B9:B39").ClearContents
For i = 1 To myMax
Cells(i + 8, "B") = myNum + i
Next i
Else '「TRUE」(B列消去あり)の場合は・・・
Range("B9:B39").ClearContents
End If

Else
k = .Row
If .Value = "" Then
Range(Cells(k, "B"), Cells(39, "B")).ClearContents
ElseIf .Value = 0 Then
Range(Cells(k + 1, "B"), Cells(myMax + 8, "B")) = 0
Else
For i = k + 1 To myMax + 8
Cells(i, "B") = Cells(i - 1, "B") + 1
Next i
End If
End If
End With
Application.EnableEvents = True
End Sub

こんな感じをご希望だったのでしょうか?m(_ _)m

投稿日時 - 2013-12-19 00:02:40

お礼

これです!!この形です。

感動しました、そして非常に参考になりました。

これからも勉強し、色々なパターンのVBAが組める様に精進します。

この度はありがとうございました。

投稿日時 - 2013-12-19 09:35:45

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

こんばんは!

http://okwave.jp/qa/q8375703.html

↑に関連した質問ですかね?
お示しのコードを詳しくみていませんが、おそらくA列にC1セルの月の日付を1~月末まで表示させたいものだと解釈して・・・

上記URLのコードに少し手を加えているだけです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myNum As Long, myMax As Long
If Intersect(Target, Range("C1,B9:B39,R9:R39")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If IsDate(Range("C1")) Then
myMax = Day(DateSerial(Year(Range("C1")), Month(Range("C1")) + 1, 1) - 1)
End If
With Target
Select Case .Column
Case 3
Range("A9:A39").ClearContents
For i = 1 To myMax
Cells(i + 8, "A") = i
Next i
myNum = Cells(40, "B").End(xlUp)
Range("B9:B39").ClearContents
For i = 1 To myMax
Cells(i + 8, "B") = myNum + i
Next i

Case 2
k = .Row
If .Value = "" Then
Range(Cells(k, "B"), Cells(39, "B")).ClearContents
ElseIf .Value = 0 Then
Range(Cells(k + 1, "B"), Cells(myMax + 8, "B")) = 0
Else
For i = k + 1 To myMax + 8
Cells(i, "B") = Cells(i - 1, "B") + 1
Next i
End If
Case Else
k = .Row
Range(Cells(k + 1, "R"), Cells(39, "R")).ClearContents
Range(Cells(k + 1, "R"), Cells(myMax + 8, "R")) = .Value
End Select
End With
Application.EnableEvents = True
End Sub

こういった感じをご希望だったのでしょうか?m(_ _)m

投稿日時 - 2013-12-18 19:54:21

補足

お久しぶりでございます。先日はお世話になりました。
今回、私がやりたいと考えているVBAは

(1)A列にC1セルの月の日付を1~月末まで自動表示させます。

(2)C1セル変更で通常の状態ならB9~B39は連続データが自動入力されます。
ここでフェイントを加え、例えばB15を空白にするとB16~B39は空白状態になる様にVBAは仕事します。
その状態のままC1セルの年月を変更したらB9~B39の連続データ表示をやめて(累計使用日数がキャンセルされると解釈して頂くと良いです。)常に空白を表示させるVBAを考えています。
それを組んでいますが、思うように出来ないですね・・・。

投稿日時 - 2013-12-18 21:17:05

お礼

これからも勉強し、色々なパターンのVBAが組める様に精進します。

この度はありがとうございました。

感謝申し上げます。

投稿日時 - 2013-12-19 09:36:41

あなたにオススメの質問