- ベストアンサー
連続データのVBAでのセルの切り替え方法について
- セルC1に年月を表記させることで、B9～B39のセルに連続データの数字を自動で記入するVBAコードを作成したが、C1に過去の年月を入力した場合にB9～B39の数字が切り替わらない問題が発生した。この問題に対して、解決方法を教えてほしい。
- 現在の日本時間の年月以前の年月（例：2013年11月以前）をC1に入力した場合、B9～B39の連続データの数字が切り替わらない問題が発生している。この問題に対して、どのように対応すればいいか、教えてほしい。
- VBAでセルC1に年月を表記させ、その値に応じてB9～B39のセルに連続データの数字を自動で記入するコードを作成した。しかし、C1に過去の年月を入力した場合にB9～B39の数字が切り替わらない問題が発生している。この問題に対して、どのように対処すれば良いか、アドバイスをいただきたい。
- Excel（エクセル）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- 連続データのVBAの質問
お世話になります。 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９に表示させるには、どうすれば良いでしょうか？
- ベストアンサー
- 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２
以前質問したＶＢＡの事で再度質問があります。度々申し訳ありません。 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 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 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初心者です
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を修正したい
数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 同一シートにC9：M33,C9：Y25,O27：Y29といった 範囲の異なる表がある場合はセル範囲をどのように記述すれば良いでしょうか？ StartCol = 4 '開始列 EndCol = 20 '終了列 BlankCount = 0 I = 16 '開始行 L = 14 '行の指定 Do While Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(L, J).Value & ActiveSheet.Cells(L + 1,J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I,J).Value = "中止" Then Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 14 tmp = "△" Case Is >= 15 tmp = "○" End Select End If Next I = I + 1 If Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) = 0 Then L = I + 1 I = I + 3 End If Loop End Sub
- 締切済み
- その他（プログラミング・開発）
- 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製品
お礼
この度はお世話になりました、このようなVBAを記入するのですね。非常に参考になりました。 感謝申し上げます。
補足
ありがとうございます。 そこで補足事項なのですが、質問した現在は２０１３年１２月ですが、日本時間の現在の年月以前の年月（今で言うと２０１３年１１月以前）をC1に記入した場合はB9～B39の連続データの数字が自動で切り替わらずに、日本時間の現在の年月以前の年月がC１セルに表記されていて、手動で指定範囲のセルの数字を変更したら、数字が連続データで記入されるようにするにはどうすれば良いでしょうか？