連続データのVBAの質問

2023/09/05 08:44

このQ&Aのポイント

VBAを使用して連続データを操作する方法についての質問です。
セルC1に年月を表記し、そのC1セルの年月を変更した場合にB9～B39のセルが自動的に連続データの数字を記入する方法についての質問です。
また、B9～B39のどこかのセルを空白にすると、そのセル以降も空白になってしまいます。C1の年月を次の月に更新した際にB39で示された数字以降の連続データをB9に表示させる方法についても質問しています。

ベストアンサー

連続データのVBAの質問

2013/12/06 18:30

お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Range("C1") <= Date - Day(Date) Then Exit Sub If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then 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 i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC１に年月を表記させ、そのC1セルの年月を変更した場合B９～B３９のセルが自動で連続データの数字を記入し、B9～B39のどこかのセルを空白にすると、そのセル以降も空白になります。そこで質問ですが、例えばB14の数字を消すとB１５～３９まで空白のセルになります。そして、B２０に１と入力するとB21～３９に連続データの数字が自動記入されます。そしてC1の年月を次の月に更新した際は、B39で示された数字以降の連続データをB９に表示させるには、どうすれば良いでしょうか？

noname#247334

Excel（エクセル）
回答数8
ありがとう数8

みんなの回答 （8）
専門家の回答

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

ベストアンサー

tom04
ベストアンサー率49% (2537/5117)

2013/12/07 20:23 回答No.8

そろそろご自身で考える努力をしてみましょう！今までのコードを見てもらえれば、どの部分をどのように変更すればどうなるのか？という操作の確認程度はご自身で理解する必要があります。今後不具合が生じた場合、他人のコードを丸写ししていたのでは改善のしようがないですよね？まずは間違ってもいいからご自身でコードを変更・訂正する習慣をつけてください。そうすればどのようなコードが最適か？はご自身でわかるようになるはずです。当然、当方が提案しているコードがベストだという訳ではありませんしひとつのコトを実行するにしても人それぞれで色々な考え方のコードがあります。それでは本題・・・＞Range(Cells(k, "B"), Cells(39, "B")).ClearContents ＞ Else の行の間に Range(Cells(k + 1, "B"), Cells(39, "B")).ClearContents ElseIf .Value = 0 Then Range(Cells(k + 1, "B"), Cells(myMax + 8, "B")) = 0 Else のように2行を追加してみてください。m(_ _)m

質問者

お礼 2013/12/07 20:31

この度はありがとうございました。 VBAに関してはあまり詳しくない為、勉強になりました。おっしゃる通りです、これでは私の勉強になりません。頼りすぎました。今後、自分で勉強し今度は自分でしっかりとVBAを組める様に努力します。その上で分からない事があれば、また宜しくお願いします。この度は長い間付き合って下さり感謝申し上げます。

その他の回答 (7)

tom04
ベストアンサー率49% (2537/5117)

2013/12/07 15:43 回答No.7

親の仇のように顔を出します。 Excel2003以前では　EOMONTH関数は分析ツールなのでVBAではダメなのかもしれません。＞myMax = Day(WorksheetFunction.EoMonth(Range("C1"), 0)) の行を＞myMax = Day(DateSerial(Year(Range("C1")), Month(Range("C1")) + 1, 1) - 1) に変更してみてください。おそらくこれで動くと思います。m(_ _)m

質問者

お礼 2013/12/07 20:32

質問者

補足 2013/12/07 18:29

いえいえ、とんでもございません。非常に感謝しています。仮にB９～B３９の何処かの場所を「０（ゼロ）」と入力すると、現在ではゼロと入力したセルの下のセルから連続データ「１、２、３、４・・・」となりますが、ゼロの場合だけ、永遠とゼロの値が自動入力される事も出来るのでしょうか？

tom04
ベストアンサー率49% (2537/5117)

2013/12/06 23:12 回答No.6

No.5の補足＞月末の３１日（年月によっては２８～３０日）を手動で空白状態にしていた場合、C1セルを更新した際B9～も空白状態にする事は出来るのでしょうか？の件について・・・ん～～～最初の質問が C1セルに変更があれば、 B9～B39セルに数値があった場合は最後の番号の次からの連番を表示なければ「1」からの連番を表示！という内容だっと解釈しています。そうなるとNo.5の補足と最初の質問は矛盾してしまいますよね？どちらがご希望なのでしょうか？いずれにしても両方の操作はできませんので、どちらか一方の操作だけになると思います。 ※　イマイチ何をしたいのかこちらでは理解できていませんので、質問と回答でいささか行き違いがあるように思えるのですが。とりあえず文面から理解できる範囲での回答ですので、この程度でごめんなさいね。m(_ _)m

質問者

お礼 2013/12/07 20:32

質問者

補足 2013/12/07 09:58

すいません、現在のVBAで満足です。ありがとうございました。最後の補足になると思いますが、このVBAをエクセル２００３で使用すると「オブジェはこのプロパティまたはメソッドをサポートしていません。」と表示され「myMax = Day(WorksheetFunction.EoMonth(Range("C1"), 0)) 」の部分で止まってしまいます。エクセル２０１３はちゃんと動きます。宜しければご教授お願いします。

tom04
ベストアンサー率49% (2537/5117)

2013/12/06 22:33 回答No.5

続けてお邪魔します。 B列の消去・R列の対応もやってみました。尚、A列が「空白の場合・・・」の条件はおそらく、この月末部分の対応ではないかと思いましたので勝手にその部分は割愛しています。必要であればその部分も追加しておいてください。 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(WorksheetFunction.EoMonth(Range("C1"), 0)) End If With Target Select Case .Column Case 3 If IsDate(.Value) = True And .Value > Date - Day(Date) Then myNum = Cells(40, "B").End(xlUp) Range("B9:B39").ClearContents For i = 1 To myMax Cells(i + 8, "B") = myNum + i Next i End If Case 2 k = .Row If .Value = "" Then Range(Cells(k, "B"), Cells(39, "B")).ClearContents 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 01:22

質問者

補足 2013/12/06 22:47

凄いですね、感動しました。非常に素晴らしい形になりました、感謝申し上げます。月末の３１日（年月によっては２８～３０日）を手動で空白状態にしていた場合、C1セルを更新した際B9～も空白状態にする事は出来るのでしょうか？

tom04
ベストアンサー率49% (2537/5117)

2013/12/06 22:09 回答No.4

No.2・3です。小の月の対応ができたいなかったようでごめんなさい。もう一度コードを載せてみます。 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,R9:R39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target Select Case .Column Case 3 If IsDate(.Value) = True And .Value > Date - Day(Date) Then myNum = Cells(40, "B").End(xlUp) For i = 1 To Day(WorksheetFunction.EoMonth(.Value, 0)) '←この行を変更（C1セルの月末数値まで） Cells(i + 8, "B") = myNum + i Next i End If Case 2 k = .Row If .Value = "" Then Range(Cells(k, "B"), Cells(39, "B")).ClearContents Else For i = k + 1 To 39 If Cells(i, "A") <> "" Then Cells(i, "B") = Cells(i - 1, "B") + 1 End If Next i End If Case Else k = .Row Range(Cells(k + 1, "R"), Cells(39, "R")) = .Value End Select End With Application.EnableEvents = True End Sub ※　月末部が表示されている場合の消去は不要なのか？ ※　R列も同様に対応しなければならないのか？という疑問を持ちつつ・・・m(_ _)m

質問者

お礼 2013/12/07 20:33

質問者

補足 2013/12/06 22:20

素早い対応ありがとうございます。 ※　月末部が表示されている場合の消去は不要なのか？ ※　R列も同様に対応しなければならないのか？そうですね、これも必要になりますね。上記２つが出来れば完璧なVBAですね。

tom04
ベストアンサー率49% (2537/5117)

2013/12/06 21:29 回答No.3

No.2です。前回のコード内の＞If IsDate(.Value) = True And .Value > Date Then を＞If IsDate(.Value) = True And .Value > Date - Day(Date) Then に変更してください。もう一度以前の質問を拝見すると、こうしないとお望み通りにならないと思います。どうも失礼いました。m(_ _)m

質問者

お礼 2013/12/07 20:31

質問者

補足 2013/12/06 21:45

すいません、わざわざありがとうございます。残り１つ不具合があります。２９～３１日が無い月（２０１４年２月など）や他の３１日が無い月の部分も表示されてしまうのですが・・・。

tom04
ベストアンサー率49% (2537/5117)

2013/12/06 21:02 回答No.2

こんばんは！今までの質問を拝見しましたが、それぞれの回答で解決済みだと思い敢えて顔を出しませんでした。今までの質問を総合的にやってみると、↓のような感じでよいのでしょうかね？ 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,R9:R39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target Select Case .Column Case 3 If IsDate(.Value) = True And .Value > Date Then myNum = Cells(40, "B").End(xlUp) For i = 1 To 31 Cells(i + 8, "B") = myNum + i Next i End If Case 2 k = .Row If .Value = "" Then Range(Cells(k, "B"), Cells(39, "B")).ClearContents Else For i = k + 1 To 39 If Cells(i, "A") <> "" Then Cells(i, "B") = Cells(i - 1, "B") + 1 End If Next i End If Case Else k = .Row Range(Cells(k + 1, "R"), Cells(39, "R")) = .Value End Select End With Application.EnableEvents = True End Sub ※　ご希望通りの動きにならなかったらごめんなさいね。m(_ _)m

質問者

お礼 2013/12/07 20:32

mt2008
ベストアンサー率52% (885/1701)

2013/12/06 19:50 回答No.1

提示されたコードは話に出てこないA列やR列などが出てきて何がしたいのか良く解らなかったので１から作り直しました。こんな感じです。 Private Sub Worksheet_Change(ByVal Target As Range) 　　'複数セルが更新された場合は処理なし　　If Target.Count > 1 Then Exit Sub 　　Application.EnableEvents = False 　　If Target.Address = "$C$1" And IsDate(Target) Then 　　　　'変更したのがC1で日付型の値だった場合の処理　　　　'最終値を取得　　　　nData = 0 　　　　If WorksheetFunction.Count(Range("B9:B39")) > 0 Then 　　　　　　nData = Range("B40").End(xlUp).Value 　　　　End If 　　　　'最終値の続きの値をB9:B39に入れる　　　　For i = 1 To 31 　　　　　　nData = nData + 1 　　　　　　Cells(8 + i, "B") = nData 　　　　Next i 　　　　ElseIf Target.Column = 2 And Target.Row >= 9 And Target.Row <= 39 Then 　　　　'変更したのがB9:B39のどれかだった場合の処理　　　　If Target = "" Then 　　　　　　'セルの値を空白にしたらそれ以下のセルも空白にする　　　　　　Range("B" & Target.Row & ":B39") = "" 　　　　ElseIf Target = 1 Then 　　　　　　'セルの値を1にしたらそれ以下のセルは1からの連番にする　　　　　　nData = 0 　　　　　　For j = Target.Row To 39 　　　　　　　　nData = nData + 1 　　　　　　　　Cells(j, "B") = nData 　　　　　　Next j 　　　　End If 　　End If 　　Application.EnableEvents = True End Sub

質問者

お礼 2013/12/07 20:33

この度は回答ありがとうございました。参考になりました、今後VBAに関して勉強し自分でしっかりコードが組める様に努力します。この度はありがとうございました。

関連するQ&A

連続データのVBAの質問
お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then 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 i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC１に年月を表記させ、そのC1セルの年月を変更した場合B９～B３９のセルが自動で連続データの数字を記入し、B9～B39のどこかのセルを空白にすると、そのセル以降も空白になります。そしてR8～R38は、指定範囲のセルに数字を入力したら、そのセル以降の指定した範囲のセルに同じ数字を自動入力するVBAです。そこで質問ですが、質問した現在は２０１３年１２月ですが、日本時間の現在の年月以前の年月（今で言うと２０１３年１１月以前）をC1に記入した場合はB9～B39の連続データの数字が切り替わらない様にするには、どうすれば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
２つの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")) If IsDate(.Value) Then 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 i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。２つめが Private Sub Worksheet_Change(ByVal Target As Range)　 Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？
- ベストアンサー
- Excel（エクセル）
セル空白時に月を変更した時の累計使用日数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には年月（２０１３年１２月）を表示させています。そして、B９～B39には累計使用日数を表示するVBAを組んでいます。 B9～B３９間に適当な数字を入力すると、連続データの数字が入力されるようになります。そして、C1セルの日付を変更しても連続データが継続して表示されるVBAです。 B３９が空白表示の場合（小月ならB38で２月ならB36かB37）でC1セルの年月を変更した場合、連続データを表示させず空白セルを表示させるVBAを組んだつもりです。しかし、上手く作動しません。もうお手上げです。どこがおかしいのでしょうか？ご教授宜しくお願いします。
- ベストアンサー
- Excel（エクセル）
VBA 範囲選択時エラー
Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。その後、A列からC列を範囲選択してDeleteするとデバック　「実行時エラー　型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub
- 締切済み
- Visual Basic
VBA　CHANGEイベントに複数イベントを
いつもお世話になっています。色々しらべて試してみたんですが、うまくいかないんで教えてください。 CHANGEイベントに複数のイベントを書き込みたいんですが。今現在、問題なく動いている以下のイベントがあります。 (1) Private Sub Worksheet_Change(ByVal Target As Range) Dim rang3 As Range Dim rang4 As Range Dim ■■ As String Dim LastRow1 As Long LastRow1 = Worksheets("○○").Cells(Rows.Count, "b").End(xlUp).Row Set rang4 = Worksheets("○○").Range("b:I" & LastRow) Set rang3 = Range("h4") If Intersect(Target, rang3) Is Nothing Then Exit Sub On Error Resume Next ■■ = WorksheetFunction.VLookup(Target.Value, rang4, 2, 0) If Err.Number > 0 Then MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" Range("h4").Select Else Application.EnableEvents = False Range("I4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 2, False) Range("j4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 3, False) Range("k4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 7, False) Range("l4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 8, False) Range("m4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 5, False) Application.EnableEvents = True Range("K4").Select End If End Sub このシートにもう一つ、イベントを入れたいのですが。 (2) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("E4")) Is Nothing Then Exit Sub Else If Range("e4").Value = "1" Then Target.Offset(0, 19).Value = "☆" End If どこに入れればいいのかわかりません。 (3) また、(2)のイベントの他に、 (1)のＶＬＯＯＬＵＰが実行され、尚且つ(2)のイベントのＥ４が値が１だった場合、Ｙ４にＨ４の値を入れたいのですが・・・。 (2)のみなら動くことは確認できましたが、(1)のｅｘｉｔ　ｓｕｂ　の直前に入れたり、ｅｎｄ　ｉｆの前に入れたりしましたが、片方は動くが、もうひとつが動かないです。 (3)については、まったくわかりません。マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。どなたか、教えてください。お願いします。
- ベストアンサー
- Visual Basic
VBA初心者です
VBA初心者です。同じセルに数字を入れて足し算して行きたいんですが！下記のVBA見つけたのですが、A1に数字を入れて答えがE1に出るんですが、同じ事を A2、A3、A4、A5答えもE2、E3......で増やしたいのですが、どうするか分かりません。どなたか教えてください。宜しくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim inp, outp As String inp = "$A$1" outp = "E1" Application.EnableEvents = False If Target.Address = inp Then Range(outp).Value = Range(outp).Value + Target.Value If Target.Value <> "" Then ActiveCell.Offset(-1, 0).Select Else Range(outp).Value = 0 End If End If Application.EnableEvents = True End Sub
- ベストアンサー
- Visual Basic
VBAでの質問
お世話になります。下記の記述で、「←」の矢印の記述で、 Cells.（５，２）がブランクでなければ、「→」から進めたいのですが、どの様に記述すれば宜しいでしょうかご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3)　　← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub
- ベストアンサー
- Visual Basic
VBA　Changeイベントのエラー
エクセルで簡単な計算書を作成しています。（マクロ初心者）ちなみにこのコードは自分で作成したものではなく、人から聞いていじってみました。 Private Sub Worksheet_Change(ByVal Target As Range) '一度に複数セルの値が変更された場合は終了 '（A5:C5を選択しDeleteも含みます。） If Target.Count > 1 Then Exit Sub If Intersect(Target, Me.Range("H170:K170", "H171:K171","C76")) Is Nothing Then Exit Sub Application.EnableEvents = False '数値かつ空白以外の場合 If IsNumeric(Target.Value) And Target.Value <> "" Then Me.Range("M170").Formula = "=if(iserror(H170*I170*J170*K170),""-"",H170*I170*J170*K170)" '空白の場合 ElseIf Target.Value = "" Then Me.Range("H170:K170,M170").Value = "-" End If Application.EnableEvents = True Application.EnableEvents = False '数値かつ空白以外の場合 If IsNumeric(Target.Value) And Target.Value <> "" Then Me.Range("M171").Formula = "=if(iserror(H171*I171*J171*K171),""-"",H171*I171*J171*K171)" '空白の場合 ElseIf Target.Value = "" Then Me.Range("H171:K171,M171").Value = "-" End If Application.EnableEvents = True Application.EnableEvents = False '空白の場合 If Target.Value = "" Then Me.Range("D76:K76","C76").Value = "-" End If Application.EnableEvents = True End Sub H170、I170、J170、K170のどれかに数値の入力があった場合、M170に計算式を入力。 H170、I170、J170、K170のどれかの値をDELETEキーでクリアした場合、H170、I170、J170、K170、M170に"-"を入力。その他に似たような処理がたくさん出てくるので、H171の処理とC76をDELETEキーでクリアした場合の処理を自分で考えて作ってみたのですが、うまく実行されません。H171～の処理はうまくいったので単純にコードをどんどん追加していけば動くと思ったんですが、いろいろ調べてもどうも方法がわからず進みません・・・解決してもらえるでしょうか・・
- ベストアンサー
- オフィス系ソフト
セル空白時に月を変更した時の累計使用日数VBA２
以前質問したＶＢＡの事で再度質問があります。度々申し訳ありません。 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 内容はC1には年月（例えば２０１３年１２月）を表示させています。 (1)A列にC1セルの月の日付を1～月末まで自動表示させます。 (２)Ｂ列には連続データ（例えば１～３１）と入力しています。そしてＢ９～Ｂ３９どこかの数値を手で数値を変えると、その数値を変えた以降の数値の連続データが表示されます。（３）Ｂ列の何処かの数値を空白にすると、その空白にした数値以降のセルも空白表示になります。（４）Ｃ１セルの年月を変更するとＡ列の日付はＣ１セルに該当する年月の日付に自動変換され、Ｂ列は最終行から引き継いで連続データを表示する様になっています。（５）Ｂ列の最終行が空白表示の場合にＣ１セルを変更するとＡ９～Ａ３９は該当する年月に変換しますが、Ｂ９：Ｂ３９は空白表示を継続して表示する様にします。質問ですが、例えばB15を空白にするとB16：B39は空白状態になる様にVBAは仕事します。その状態のままC1セルの年月を変更したらB9：B39は空白を表示させるVBAで質問をし一旦解決したと思いました。しかしこのコードでＢ９：Ｂ３９に空白でなく、普通に連続データが表記されている状態でＣ１セルを変更してもＢ９：Ｂ３９が空白表示になってしまいます。まとめますと・・・ (1)Ｂ列の最終行（２月は日付が２８日or２９日なのでＢ３６or３７、３０日が最終日の日付ならＢ３８、３１日の日付ならＢ３９）が空白表示の状態でＣ１セルを変更した時はＢ９：Ｂ３９は空白表示にする。 (2)Ｂ列が空白表示の時に、Ｂ９：Ｂ３９のどこかに数値を入力したら、その入力した数値以降の連続データが自動表記する。（例えばＢ２０に「５」と入力したらＢ２１に「６」Ｂ２２に「７」・・・と） (3)Ｂ列の最終行（２月は日付が２８日or２９日なのでＢ３６or３７、３０日が最終日の日付ならＢ３８、３１日の日付ならＢ３９）に連続データが表示されている場合でＣ１セルを変更した場合は変更前の連続データを継続させＢ９：Ｂ３９に順番に連続データを表示させる。（例えばＢ３９に「３１」と入力されている状態でＣ１セルを変更した場合Ｂ９に「３２」Ｂ１０に「３３」・・・と連続データを表記させる。）この３つの条件を高度に融合したコードは、どの様に組めば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
VBAで入力ミスの時、空白に戻すには
いつもお世話になります WINDOWS7 EXCELL2010 です。何れかのセルで入力ミスを、例えば　I13 に　1　を入力した時　「日」が当然表示されますがこれがミスで空白に戻したい時に「0」　で空白できると考えていましたが実際は空白でないみたいです。見た目では空白ですが空白のセルのカウント　COUNTBLANLK では1つ少なくなっています。このようなミスの時に空白に戻す方法はどのようにすればいいかご教授いただけませんか。よろしくお願いします。参考空白のセルのカウント AO13 =IF($B13="","",COUNTBLANK($I13:$AM13)) 入力のVBA Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("I13:AM27")) Is Nothing Then Exit Sub 'ココで範囲指定 Application.EnableEvents = False If Target.Value = 0 Then Target.Value = " " If Target.Value = 1 Then Target.Value = "日" If Target.Value = 2 Then Target.Value = "△" If Target.Value = 3 Then Target.Value = "▼" If Target.Value = 4 Then Target.Value = "前" If Target.Value = 5 Then Target.Value = "夜" If Target.Value = 6 Then Target.Value = "明" If Target.Value = 7 Then Target.Value = "有" Application.EnableEvents = True End Sub
- ベストアンサー
- その他MS Office製品