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

セル空白時に月を変更した時の累計使用日数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３７、３０日が最終日の日付ならＢ３８、３１日の日付ならＢ３９）に連続データが表示されている場合でＣ１セルを変更した場合は変更前の連続データを継続させＢ９：Ｂ３９に順番に連続データを表示させる。（例えばＢ３９に「３１」と入力されている状態でＣ１セルを変更した場合Ｂ９に「３２」Ｂ１０に「３３」・・・と連続データを表記させる。）この３つの条件を高度に融合したコードは、どの様に組めば宜しいでしょうか？

２つの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ですが、どのようにして組み合わせれば良いのでしょうか？

連続データの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９に表示させるには、どうすれば良いでしょうか？

連続データの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の連続データの数字が切り替わらない様にするには、どうすれば宜しいでしょうか？

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

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

EXCELのVBAでセル値の移動でエラー

EXCEL2002のVBAでセル値の移動をVBAでやりたいのですが (1)の様に1行は出来るのですが、(2)の様に２行を移動させるとエラー（実行時エラー1004　アプリケーション定義またはオブジェクト定義のアラーです。）が出てしまいます。 (2)のマクロでどうしてエラーが出るのか分かりません。エラーを出さずに2行目を移動させる方法を教えてください。 (1)_____________________________________＿＿＿＿＿＿＿＿＿＿＿＿ If Range("L1") <> detachn Then i = 9 While i >= 1 Cells(1, i + 13).Value = Cells(1, i + 12).Value i = i - 1 Wend Cells(1, 13).Value = Range("L1").Value datachn = Range("L1").Value End If (2)________________________________＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ If Range("L1") <> detachn Then i = 9 While i >= 1 Cells(1, i + 13).Value = Cells(1, i + 12).Value Cells(2, i + 13).Value = Cells(2, i + 12).Value ←ここでエラー i = i - 1 Wend Cells(1, 13).Value = Range("L1").Value Cells(2, 13).Value = Range("L2").Value datachn = Range("L1").Value End If

VBAエクセル空白セル0の入力

C列が空白となるまで、F列・・・L列の空白セルに0を代入する。という処理を行いたく以下コードで実行をしてファイル種類をCSVにて、保存した後名前の変更で拡張子をTXTにするとデータ入力された列の以降がカンマの羅列が「,,,,,,,,(改行)」の繰り返しで表示されてしまいます。 (CSV保存の後、視覚的に空白部分を行選択して削除するとなくなります。) どうすれば、このカンマが表示されなくなるでしょうか。うまく説明できてないですが、アドバイス御願いします。 Dim i As Long i = 3 Do Until Cells(i, 3).Value = "" If Cells(i, 6).Value = "" Then Cells(i, 6).Value = "0" End If If Cells(i, 7).Value = "" Then Cells(i, 7).Value = "0" End If If Cells(i, 8).Value = "" Then Cells(i, 8).Value = "0" End If If Cells(i, 9).Value = "" Then Cells(i, 9).Value = "0" End If If Cells(i, 10).Value = "" Then Cells(i, 10).Value = "0" End If If Cells(i, 11).Value = "" Then Cells(i, 11).Value = "0" End If If Cells(i, 12).Value = "" Then Cells(i, 12).Value = "0" End If i = i + 1 Loop

空白セルに●を入れたい

Excelのセル範囲（例：としてA1からC10）のセルを調べて、空白のセルになにかの文字（例：●）を打ち込みたい場合のVBAの書き方を教えてください。 Sub セル埋め() Dim r As Range, i As Range Set r = Range("A1:C10") '範囲指定 If Intersect(r, Target) Is Nothing Then For Each i In r If i.Value = "" Then i.Value = "●" Next i End Sub この書き方にこだわっているわけではないので、もっと簡単なやり方でもけっこうです。

Excel VBA　セルの双方向同期のエラーについ

エラーが発生して理由がわからないので、どなたか助言をお願いします。以下のVBAにて、目的のセルにデータを入力すると、1回目は必ず添付写真の通りのエラーが出まして、デバッグをすると3行目が黄色でハイライトされます。記述は以下の通りです。どうぞよろしくお願いします。シートAへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("シートB").Range("$B$1").Value = Sheets("シートA").Range("$A$1").Value End If End Sub シートBへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("シートA").Range("$A$1").Value = Sheets("シートB").Range("$B$1").Value End If End Sub

シート内の特定のセルの範囲が変化した時、

シート内の特定のセルの範囲が変化した時、まずＡ列の最大値を求めて、その後Ａ列とＤ列のそれぞれの条件にあった行のＡ列に最大値＋１を表示させるようにしたいのですが動作しません。なぜ動かないか教えて下さい。参考までに、そのプログラムを記載します。宜しくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <= 3 Or Target.Row > 65000 And Target.Column = 4 Then Dim i, j, max As Integer max = 0 For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row If max < Range("A" & i).Value Then max = Range("A" & i).Value End If Next i For j = 3 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(j, 1) = "" And Not Cells(j, 4) = "" Then Cells(j, 1) = max + 1 End If Next j End If End Sub

VBA A1セルが空白になったら隣のセルも空白に

いつもお世話になります。 WINDOWS7 EXCELL2010 です。 A1セルに文字列で５桁のID番号を入力するとI4のセルに今日の日付が入るようにマクロを作っています。このときA1セルをキーボードのBacksPaceでID番号を消してエンターキーを押した時にI4セルも空白にしたいと考えて下記のように作りましたが If Range("A1") = “” Range("$I$4") = "0000/00/00" Else Range("$I$4").ClearContents 上の構文が上手くゆかず困り果てました。どのようにすればいいか御指導願えませんでしょうか。参考に Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Range("I4").Value = Date If Range("A1") = “” Range("$I$4") = "0000/00/00" Else Range("$I$4").ClearContents End Sub

入力規則のドロップダウンリストを連動

以下のサイトを参考に別ブックからデータを参照する方法で苦戦しています。 http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_validation.html Sub name_1() 　　Dim lCol As Long, lRow As Long 　　Dim i As Long, nName As String Dim Wb As Workbook ←追記 Set Wb = Workbooks("MyBook.xls") ←追記　　　　On Error Resume Next 　　　　With Wb.Sheets("Sheet2") 　　　　　　lCol = .Range("A1").End(xlToRight).Column 　　　　　　ActiveWorkbook.Names("項目リスト").Delete 　　　　　　ActiveWorkbook.Names.Add Name:="項目リスト", _ 　　　　　　　　RefersTo:=.Range(.Cells(1, 1), .Cells(1, lCol)) 　　　　　　'----名前の定義　　　　　　For i = 1 To lCol 　　　　　　　　lRow = .Cells(1, i).End(xlDown).Row 　　　　　　　　nName = .Cells(1, i).Value 　　　　　　　　ActiveWorkbook.Names(nName).Delete 　　　　　　　　.Range(.Cells(1, i), .Cells(lRow, i)).CreateNames Top:=True 　　　　　　Next i 　　　　End With End Sub Sub Macro2() 　　name_1 　　With Range("A2:A10").Validation 　　　　'--入力規則を削除　　　　.Delete 　　　　'--入力規則を設定　　　　.Add Type:=xlValidateList, _ 　　　　　　Formula1:="=項目リスト" 　　End With 　　'--B2セルへ入力規則を設定　　With Range("B2:B10").Validation 　　　　.Delete 　　　　.Add Type:=xlValidateList, _ 　　　　　　Formula1:="=IF(A2="""",A2,INDIRECT(A2))" 　　End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) 　　Dim c As Range Dim Wb As Workbook ←追記 Set Wb = Workbooks("MyBook.xls") ←追記　　　　If Not (Application.Intersect(Target, Range("A2:B10")) Is Nothing) Then 　　　　name_1 　　　　Application.EnableEvents = False 　　　　　　If Target.Column = 1 Then 　　　　　　　　If Target.Value = "" Then 　　　　　　　　　　Target.Offset(0, 1).Value = "" 　　　　　　　　Else 　　　　　　　　　　Set c = Wb.Sheets("Sheet2").Range(Target.Value).Find(Target.Offset(0, 1).Value, lookat:=xlWhole) ←ここでエラー　　　　　　　　　　If c Is Nothing Then 　　　　　　　　　　　　Target.Offset(0, 1).Value = "" 　　　　　　　　　　End If 　　　　　　　　End If 　　　　　　End If 　　　　　　If Target.Column = 2 Then 　　　　　　　　If Target.Value = "" Then 　　　　　　　　　　Target.Offset(0, -1).Value = "" 　　　　　　　　End If 　　　　　　End If 　　　　Application.EnableEvents = True 　　　　End If End Sub どのように改変すれば良いのでしょうか？

VBAにて複数選択したセルの値に選択した値の追加

いつもこちらではお世話になっております。現在VBAにて機能実現において、つまずいております。複数選択したセルの値の後ろに、プルダウンから選択した値を追加したいと考えております。値は追加できるのですが、選択を開始したセルの値が他のセルにも反映されてしまうという状況です。それぞれのセルの値にプルダウンから選んだ値を追加しようと思えば、どのような方法で行えばよいでしょうか？よろしければご教授お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim a As Integer If Target.Address = "$B$1" Then Application.EnableEvents = False a = Cells(1, 2).Value Selection.Value = Selection.Value & a Cells(1, 2).Value = "" Application.EnableEvents = True End If End Sub 以下の画像は、実現したい画面のイメージと現在の状態です。

空白セルと０値を識別させたい。（VBA）

すみません、誰か教えていただけますか。シートの53、54、55行目にそれぞれ値入っています。それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が続く部分の合計を出しています。しかし、下記の記述ですと数値が0（変数D=0）の時にうまくいきません。空白セルと認識されてしまうと思います。何か、良い方法があれば教えて頂けませんでしょうか。宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub

【VBA】初心者ですセルの貼り付けについて

VBAについてご質問です以下のようなVBAを、こちらの質問等を参考に作成したのですが、シートにそれぞれデータを貼り付ける際、値貼り付けになってしまいます書式ごと貼り付けるようにしたのですが、どのように改良すればよいでしょかご教示よろしくお願いいたします Sub ぶんるい() Dim r As Long Dim Target As Variant For r = 14 To 100 Select Case Cells(r, "D").Value Case "大阪" Target = "大阪" Case "名古屋" Target = "名古屋" Case Else Target = "" End Select If Target <> "" Then Worksheets(Target).Range("A65536").End(xlUp).Offset(1).Resize(1, 14).Value = _ Cells(r, "H").Resize(1, 14).Value End If Next r End Sub

[VBA] セルの色を塗りつぶす

条件付き書式では出来ないみたいなので、VBAに挑戦しましたが苦労しています。 Win 8, excel 2010です。「ある１つのセルが100の時、その左横の4列をある色で塗りつぶす」という事を行いたいのですが、ネットで調べたものをちょっとアレンジしてみましたが Sub change(ByVal Target As Range) Dim myColor As Variant If Target.Count <> 1 Then Exit Sub If Target.Column <> 4 Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case 100 myColor = 3 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 4).Interior.ColorIndex = myColor Application.EnableEvents = True End Sub change(関数名)の横に引数があるから(参照渡し？？？) マクロに表示されないという情報を見つけたのですが、色々やっても訳が分からなくなりました。どうすれば実行できるようになるのでしょうか？

文字を入力したセル以降のセルも同じ文字になるVBA

Private Sub Worksheet_Change(ByVal Target As Range) Dim R As Range ActiveSheet.Protect UserInterfaceOnly:=True Set R = Union(Range("D5:D38"), Range("E5:E38"), Range("T5:T38")) With Target If Intersect(.Cells, R) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(.Row, .Column), Cells(38, .Column)).Value = .Value Application.EnableEvents = True End With End Sub この様なコードがあるのですが範囲を変更したいと思います。 D５：D38は上記コードのままで良いのですが、E5；E38はE5：E36に、T5：T38はT5：T36に変更するにはどうすれば良いのでしょうか？

Excel マクロのFor～Nextで再起動エラー

勤務表を作っています。下記の’ＯＫまでは希望どうりうまく出来ていたのですが、勤務表の下セルに各列の人員（行）１０名分位Ａ，Ｂ,Cの計を表示させたい。実行するとエラー「Microsoft office Excel　再起動」を求められます。　for～が判断指令が<重い>のでしょうか。なんとか回避さする方法を教えてください。 Win XP Sp2 Office Excel 2007です。今回これを作るにあたり初ＶＢＡ使用者です。 '　C入力後の翌日は休をセット。CC連続は休休セット。 Private Sub Worksheet_Change(ByVal Target As Range) Dim cnt As Variant Dim a1 As Byte Dim b1 As Byte Dim c1 As Byte Dim nin As Variant Dim retsu As Variant If Target.Count > 1 Then Exit Sub '複数セルの入力は無視 'Ａ If Target.Value = "Ａ" Or Target.Value = "A" Then Target.Value = "A" Range("AV16").Value = Target.Column End If 'Ｂ If Target.Value = "Ｂ" Or Target.Value = "B" Then Target.Value = "B" Range("AV16").Value = Target.Column End If 'Ｃ If Target.Value = "Ｃ" Or Target.Value = "C" Then Range("AV16").Value = Target.Column Target.Value = "C" Else End If ' If Target.Value = "C" Then If Target.Offset(0, -1).Value = "C" Then 'Ｃが連続したら Target.Offset(0, 1).Resize(1, 2).Value = ("休") '連休に Else End If Target.Offset(0, 1).Value = ("休") 　　'そうでなければ休 End If 'A,B,C の数をカウントする。 nin = Range("AV15")　　'別のプログラムから入力した人員数 retsu = Range("AV16")　　' A,B,Cのいずれかを入力したセル列。Target.Column ’OK For cnt = 7 To (6 + nin) If cells(cnt, retsu) = "A" Then a1 = a1 + 1 End If If cells(cnt, retsu) = "B" Then b1 = b1 + 1 End If If cells(cnt, retsu) = "C" Then c1 = c1 + 1 End If Next cnt cells(nin + 7, retsu) = a1 'Ａ番 cells(nin + 8, retsu) = b1 'Ｂ番 cells(nin + 9, retsu) = c1 'Ｃ番 End Sub

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

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

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

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

お礼 2013/12/19 09:35

その他の回答 (1)

お礼 2013/12/19 09:36

補足 2013/12/18 21:17

関連するQ&A

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

２つのVBAを組み合わせる方法

連続データのVBAの質問

連続データのVBAの質問

VBAで入力ミスの時、空白に戻すには

VBA 範囲選択時エラー

EXCELのVBAでセル値の移動でエラー

VBAエクセル空白セル0の入力

空白セルに●を入れたい

Excel VBA　セルの双方向同期のエラーについ

シート内の特定のセルの範囲が変化した時、

VBA A1セルが空白になったら隣のセルも空白に

入力規則のドロップダウンリストを連動

VBAにて複数選択したセルの値に選択した値の追加

空白セルと０値を識別させたい。（VBA）

【VBA】初心者ですセルの貼り付けについて

[VBA] セルの色を塗りつぶす

文字を入力したセル以降のセルも同じ文字になるVBA

Excel マクロのFor～Nextで再起動エラー

VBA初心者です

注目のQ&A

カテゴリ
一覧

専門家に質問してみよう
専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

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

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

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

お礼 2013/12/19 09:35

その他の回答 (1)

お礼 2013/12/19 09:36

補足 2013/12/18 21:17

関連するQ&A

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

２つのVBAを組み合わせる方法

連続データのVBAの質問

連続データのVBAの質問

VBAで入力ミスの時、空白に戻すには

VBA 範囲選択時エラー

EXCELのVBAでセル値の移動でエラー

VBAエクセル空白セル0の入力

空白セルに●を入れたい

Excel VBA セルの双方向同期のエラーについ

シート内の特定のセルの範囲が変化した時、

VBA A1セルが空白になったら隣のセルも空白に

入力規則のドロップダウンリストを連動

VBAにて複数選択したセルの値に選択した値の追加

空白セルと０値を識別させたい。（VBA）

【VBA】初心者です セルの貼り付けについて

[VBA] セルの色を塗りつぶす

文字を入力したセル以降のセルも同じ文字になるVBA

Excel マクロのFor～Nextで再起動エラー

VBA初心者です

注目のQ&A

カテゴリ 一覧

専門家に質問してみよう 専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

Excel VBA　セルの双方向同期のエラーについ

【VBA】初心者ですセルの貼り付けについて

カテゴリ
一覧

専門家に質問してみよう
専門家登録