- ベストアンサー
セル空白時に月を変更した時の累計使用日数VBA２
- VBAを使用して、指定した条件に応じてセルの動作を制御するコードを作成したいです。
- 具体的には、以下の3つの条件を組み合わせたコードを作成したいです。 (1) B列の最終行が空白の場合、C1セルを変更した時にB9:B39を空白にする。 (2) B列が空白の場合、B9:B39の中に数値を入力するとその後の連続データが自動で表示される。 (3) B列の最終行に連続データが表示されている場合、C1セルを変更した後も変更前の連続データを継続させ、B9:B39に順番に連続データを表示させる。
- これらの条件を組み合わせた高度なVBAコードの作成方法について教えてください。
- Excel（エクセル）
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
No.1です。 ＞「Cells(i, "B") = Cells(Rows.Count, "A").End(xlUp) + i - 8」が黄色く表示されます。 Excel2003でも大丈夫のはずです。 エラーの行だけコードに手を加えてみました。 もう一度最初から載せてみます。 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 '★ここから追加 If WorksheetFunction.Count(Range("B9:B39")) = 0 Then For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Cells(i, "B") = Range("A9").End(xlDown) + i - 8 '※ ←少しいじってみました。 Next i End If 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 ※ シートモジュールのChangeイベントなどで一旦エラーが出てしまうと、そのSheetそのものが動かなくなることがありますので、 まっさらなSheetで試してみてください。 ご希望通りになれば良いのですが・・・m(_ _)m
その他の回答 (1)
- tom04
- ベストアンサー率49% (2537/5117)
こんばんは！ あっているかどうか判りませんが、前回のコードに少し手を加えてみました。 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 '★ここから追加 If WorksheetFunction.Count(Range("B9:B39")) = 0 Then For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Cells(i, "B") = Cells(Rows.Count, "A").End(xlUp) + i - 8 Next i End If 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
お礼
問題が無事に解決出来ました！！ この度は長い間僕に付き合って下さり誠に感謝申し上げます。 これからも宜しくお願い申し上げます。
補足
お久しぶりです、僕の質問に長い間付き合っていただき誠にありがとうございます。勉強中ですが色々と忙しくてなかなか上手く出来ません。 コードを実際に試してＣ１セルの年月を変更したら「実行時エラー１３ 型が一致しません」と表記され「Cells(i, "B") = Cells(Rows.Count, "A").End(xlUp) + i - 8」が黄色く表示されます。 言い忘れていましたが僕のエクセルの種類はエクセル２００３を使用しているので何か不具合でもあるのでしょうか？
お礼
問題が無事に解決出来ました！！ この度は長い間僕に付き合って下さり誠に感謝申し上げます。 これからも宜しくお願い申し上げます。