• ベストアンサー
  • 暇なときにでも

ThisWorkBookモジュールとSheetモジュールの両立

エクセル2003でマクロを組んでいます。 Sheet1,Sheet2の2つのシートがあり、 片方のシートの"A4:G10"の範囲に値を書き込むと、もう片方の同じ位置に同じ値が書き込まれるようなマクロを組みたいです。 以前ここで教えていただいたものを改変して以下を作りました(ThisWorkBookモジュールです)。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim Num As Integer Dim S As String, Sh_name As String Sh_name = ActiveSheet.Name Set r = Intersect(Target, Range("A4:G10")) If Not (r Is Nothing) Then Application.EnableEvents = False For Num = 1 To 2 S = "Sheet" & Num If S <> Sh_name Then Worksheets(S).Range(r.Address).Value = r.Value End If Next Application.EnableEvents = True End If End Sub ここまでは正常に動作します。 また、 Sheet1とSheet2のモジュールに、 A列のセルに値が入力された場合、同じ行のC列のセルの色を塗るという記述をしています。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Cells(Target.Row, 3).Interior.ColorIndex = 5 End If End Sub これらを同時に生かしたいのですが、 どのように書けばいいでしょうか。 EnableEvents = False/Trueを消してしまうと、 Worksheets(S).Range(r.Address).Value = r.Valueが実行されるたびにThisWorkBookモジュールが動いているようです。 そして2回目のSet r = Intersect(Target, Range("A4:G10"))でエラーが出ます。 (エラーは出ずとも延々と(無限ではない回数)ThisWorkBookモジュールを繰り返したコードもありました。) よろしくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数839
  • ありがとう数3

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

  • ベストアンサー
  • 回答No.3
  • Wendy02
  • ベストアンサー率57% (3570/6232)

補足: >今考えうる「全て」は、値、フォントの色、セル背景色、罫線です。 もし、フォントの色、セルの背景色、罫線のイベントで取ろうとしたら、インスタンスを作らないといけないので、かなり長いコードになるし、まったく発想が違います。今の延長上ではありませんから、これ以上の方法を願うのでしたら、「作業グループ」を取ってください。 例:  Worksheets(Array("Sheet1", "Sheet2")).Select そうでなかったら、Worksheet_Activate() などで、特定の範囲をコピーしたほうが楽です。 以前も、同じような質問が出ていましたが、同期と言っても、二つのWindowを開くなら別ですが、そうでなければ、見えないシートに対しては、開けるまでは、正確にはどうなっているかはわからないのですから。(値は、参照式があるので別ですが。) >(3)は、ThisWorkBookモジュールで(2)を行った時にSheet2のシートモジュールが動いて欲しかったのですが、 それをするなら、もともと、Sheet イベントは不必要です。 サブルーチン・マクロを呼び出せばよいのです。 'ThisWorkbook モジュール Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  Application.EnableEvents = False  If StrComp(Sh.Name, "Sheet1") = 0 And Not Intersect(Target, Range("A4:G10")) Is Nothing Then    Worksheets("Sheet2").Range(Target.Address).Value = Target.Value    Call WorksheetsChange(Target.Address)  ElseIf StrComp(Sh.Name, "Sheet2") = 0 And Not Intersect(Target, Range("A4:G10")) Is Nothing Then    Worksheets("Sheet1").Range(Target.Address).Value = Target.Value    Call WorksheetsChange(Target.Address)  End If  Application.EnableEvents = True End Sub '標準モジュール 'プロシージャ名は、紛らわしい名前をあえてつけた Sub WorksheetsChange(myTarget As String) Dim Sh As Worksheet   For Each Sh In Worksheets(Array("Sheet1", "Sheet2"))   With Sh   If .Range(myTarget).Column = 1 Then     If .Range(myTarget).Cells(1).Value <> "" Then       .Range(myTarget).Offset(, 2).Interior.ColorIndex = 5     Else       .Range(myTarget).Offset(, 2).Interior.ColorIndex = xlColorIndexNone     End If   End If   End With   Next Sh End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

回答ありがとうございます。 返信が遅れて申し訳ありません。 挙げていただいたコードで満足のいく結果となりました。 シートイベントは要らなかったんですね。 これから標準モジュールに、背景色以外で同期を取りたい内容を加えていこうと思います。 今回は作業グループは使わないことにしましたが、使った方が処理速度は速いでしょうか。

関連するQ&A

  • このマクロあっていますでしょうか?よろしくお願いいたします。

    ★sheetA Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$14" And Target.Address <> "$C$19" _ And Target.Address <> "$F$19" Then Exit Sub If Target.Address <> "$R$14" And Target.Address <> "$S$14" _ And Target.Address <> "$T$19" Then Exit Sub Application.EnableEvents = False With Sheets("B") .Range("F14").Value = Range("C14").Value .Range("F17").Value = Range("C19").Value .Range("F20").Value = Range("F14").Value .Range("F23").Value = Range("F19").Value End With With Sheets("C") .Range("F13").Value = Range("R14").Value .Range("F14").Value = Range("S14").Value .Range("F18").Value = Range("T19").Value End With Application.EnableEvents = True End Sub ★sheetB Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$14" And Target.Address <> "$F$17" _ And Target.Address <> "$F$23" Then Exit Sub Application.EnableEvents = False With Sheets("A") .Range("C14").Value = Range("F14").Value .Range("C19").Value = Range("F17").Value .Range("F19").Value = Range("F23").Value End With Application.EnableEvents = True End Sub ★sheetC Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$13" And Target.Address <> "$F$14" _ And Target.Address <> "$F$18" Then Exit Sub Application.EnableEvents = False With Sheets("A") .Range("R14").Value = Range("F13").Value .Range("S14").Value = Range("F14").Value .Range("T19").Value = Range("F18").Value End With Application.EnableEvents = True End Sub

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

    お世話になります、2つのVBAを組み合わせる方法で迷っています。 1つ目が 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 です。 2つめが 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 です。2つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか?

  • excel2007 VBで

    下記のマクロ作成して実際にセルにA、あるいは何かデータを入力しても下記イベント?が発生している気配がありません。 Application.EnableEvents = Falseの行がなにか問題なのでしょうか。実プログラムは If Target.Value = "A" Or Target.Value = "A" Thenの他にB、C、計算も含んでいるのですがApplication.EnableEvents = TrueはEnd Subの前行に入れてあります。 他に設定することがあるのでしょうか。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range)    If Target.Count > 1 Then Exit Sub '複数セルの入力は無視 Application.EnableEvents = False '割込み停止 ’[B3] = 123 ’Stop If Target.Value = "A" Or Target.Value = "A" Then Target.Value = "A" End If Application.EnableEvents = True '割込み再開 End Sub excel2007 VB6.5です。

その他の回答 (2)

  • 回答No.2
  • Wendy02
  • ベストアンサー率57% (3570/6232)

こんばんは。 >『Sheet1と2において指定した範囲の全ての同期を取る』です。 >今考えうる「全て」は、値、フォントの色、セル背景色、罫線です。 なるべく、最初から、そういうことは書いていただいたほうがよいですね。あまり後出しの条件が多いと、書いてきた全ての内容がひっくり返ってしまうことがあります。 最初に書かなかったけれども、最初から同期を取る目的なら、二つのシートを作業グループにしたほうが早いです。それで全てが済むはずです。最初、掲示する前に、そういうマクロを書いたけれども、趣旨が違うと思って載せませんでした。 マクロのマクロのような方法は、難しくなるだけだと思います。 >すみません、絶対の自信があるわけじゃないのですが、 >できればどうヘンなのか教えていただけないでしょうか。 >Sh_name = ActiveSheet.Name >Set r = Intersect(Target, Range("A4:G10")) そういうコードを回答者の中でも書く人がいますが、引数がきちんと捕らえられていないと思います。 引数、Sh は、ActiveSheet だからですし、 Intersect(Target, Range("A4:G10")) シートの指定がない前の確実性がない時に、Intersect の戻り値を Range オブジェクトを変数に代入しているけれど、単に、範囲のチェッカーだけに使えばよいと思います。それと、引数 Target で取得しているのだから、それを使えば済むわけです。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

回答ありがとうございます。 返信が遅れて申し訳ありません。 >二つのシートを作業グループにしたほうが早いです。 「シートを作業グループにする」という記述があるのですね、「マクロの記録」でしっかり記録できました。 (Arrayを使ってシート数分やってるだけみたいですけど) これも使ってみようと思います。 >>できればどうヘンなのか教えていただけないでしょうか。 >引数がきちんと捕らえられていないと思います。 正直まだ理解できないようです、聞いておいて申し訳ありません。 Sh.nameで入力したシート名が手に入ることだけはわかりました。

  • 回答No.1
  • Wendy02
  • ベストアンサー率57% (3570/6232)

こんにちは。 ご質問者さんの、その Workbook_SheetChange のコードがちょっとヘンですね。前回のご質問で、これを出していただければすぐに分かりましたが。 >Sh_name = ActiveSheet.Name >Set r = Intersect(Target, Range("A4:G10")) この二行がヘンです。 >Worksheets(S).Range(r.Address).Value = r.Valueが実行されるたびにThisWorkBookモジュールが動いているようです。 Workbook_SheetChange 自体は、どこのシートのどの場所でも、入力すれば呼び出します。 ThisWorkbook モジュール Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  Application.EnableEvents = False  If StrComp(Sh.Name, "Sheet1") = 0 And Not Intersect(Target, Range("A4:G10")) Is Nothing Then    Worksheets("Sheet2").Range(Target.Address).Value = Target.Value  ElseIf StrComp(Sh.Name, "Sheet2") = 0 And Not Intersect(Target, Range("A4:G10")) Is Nothing Then    Worksheets("Sheet1").Range(Target.Address).Value = Target.Value  End If  Application.EnableEvents = True End Sub なお、私なら、シートモジュールは、こんな感じに色消しも入れます。 これは、好みによります。こちらは、特に問題ありません。 Private Sub Worksheet_Change(ByVal Target As Range)   If Target.Column = 1 Then     If Target.Cells(1).Value <> "" Then       Target.Offset(, 2).Interior.ColorIndex = 5     Else       Target.Offset(, 2).Interior.ColorIndex = xlColorIndexNone     End If   End If End Sub      

共感・感謝の気持ちを伝えよう!

質問者からの補足

いつも回答ありがとうございます。 申し訳ありません、ちょっと説明不足でした。 「同時に生かしたい」と書いたのは、  ・各シートにおいてA4:G10の範囲の値について同期を取る  ・各シートのA列に値が入ったら同行のC列は青で塗る の2点です。 例えばSheet1のA1に"1"と入力した時の結果として、  (1)Sheet1のC1が青で塗られる。→Sheet1のシートモジュールの結果  (2)Sheet2のA1に"1"が入力される。→ThisWorkBookモジュールの結果  (3)Sheet2のC1が青で塗られる。→(ThisWorkBookモジュールの結果による)Sheet2のシートモジュールの結果 を行いたいです。 質問した時点で、 (1)は既にできており(問題無いと言ってもらえました)、 (2)も(ヘンと言われてしまいましたが結果的には)動いていました。 (3)は、ThisWorkBookモジュールで(2)を行った時にSheet2のシートモジュールが動いて欲しかったのですが、 Application.EnableEvents = Falseでイベントを止めているので動きません。 Application.EnableEvents = Falseを消すと、ループしてしまうのでNGです。 そこで、 (3)も実現するにはどのように組んだらよいでしょうか、というのが意図していた質問でした。 もしかして不可能でしょうか。 ちなみにコード中でSheet1と2にしか対応していないのにFor文で回している理由は、 Sheetが増えた時に対応しやすいかなと思ってのことです。 今回はこのようなコードしか思いつけなかったのでこれを質問しましたが、 目的としては、 『Sheet1と2において指定した範囲の全ての同期を取る』 です。 今考えうる「全て」は、値、フォントの色、セル背景色、罫線です。 例)  Sheet1に値の入力があった→Sheet2の同じ位置に入力。  Sheet2のセルの色を青に→Sheet1の同じ位置のセルの色を青に。 他にもっと確実な方法でもあれば教えていただきたいです。 >Workbook_SheetChange のコードがちょっとヘンですね。 すみません、絶対の自信があるわけじゃないのですが、 できればどうヘンなのか教えていただけないでしょうか。 よろしくお願いします。

関連するQ&A

  • マクロで二つの構文を繋ぐには

    いつもお世話になります。 WIN7 EXCELL2010 です。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub ThisWorkbook に上記のマクロに下記のマクロを追加したいのですが、 End Sub の ところを End If End With などに変えたのですがうまくゆきません。 御指導お願いできませんでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("M3:V27")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case "○" Target.Value = "●" Case Else Target.ClearContents End Select Cancel = True End If 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

  • Excelでシート名と最終更新日を自動表示したい

    Excelを使って (1)セルA1に入れた名目をシート名にし (2)セルH1には、最終更新日を自動で入れたいです。 調べた結果、 シート名を右クリックして「コードの表示」から (1)は Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub を入れてうまくいきましたが、 (2)は Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  If ThisWorkbook.Saved = False Then   Worksheets("Sheet1").Range("H1").Value = Date  End If End Sub を入れてみましたが(←調べましたもの) うまくいきませんでした。 単純に、 Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  If ThisWorkbook.Saved = False Then   Worksheets("Sheet1").Range("H1").Value = Date  End If End Sub とつなげて入れるのではだめなんでしょうか? それとも、(2)の何かが間違っていますか? ご教授願います。

  • 2つのマクロを挿入すると動作せず

    現在、C10に値が入力されるとG4に発行日が表示される 下記のマクロを入力しています。 1 発行日の日付 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$10" Then Target.Offset(-6, 2).Value = Date End If End Sub この上のマクロのみは上手く作動しています。 ファイル名を自動で保存するために下記のマクロをしたいので追加しました。 2 ファイル名の自動保存   Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 And Target.Column = 1 Then ActiveSheet.Name = Target.Value ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Target.Value End If End Sub 3  上記の1+2で下記の如くし、いろいろトライをしていますが 上手くゆきません。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 And Target.Column = 1 Then ActiveSheet.Name = Target.Value ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Target.Value End If If Target.Address = "$C$10" Then Target.Offset(-6, 2).Value = Date End If End Sub ブック内は次のようなファイルです。 Sheet1(納品請求書1)~Sheet3(納品請求書3) Sheet4(月請求書) Sheet5(顧客登録) Sheet6(設定) Sheet7(領収書) Sheet8(file)  ここのA1に保存したいファイル名を入れています。 上手く表示されません。 困っています。 ここでご教授いただきたいのは 2のみのマクロだと問題なく「ファイル名とシート名」が自動的に表示され保存ができます。 私のやり方に何か問題があると思います。 上記の1(発行日の日付け)+2(ファイル名の自動保存)したときにはうまくいかず何かいい方法がないでしょうか。 お知恵をお貸し下さい。

  • select case文について

    リストから選択とリストに無い値の入力のリストへの追加をしたく、あちこちの情報をつぎはぎで下記のようにVBAで動かそうとしましたが、うまく動いてくれません。 前(Case A)は動くのですが、あと(Case 2)が機能しません。 それと、3つ以上をSelectCaseで組む場合の方法も合わせてお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Dim LastR As Long Select Case Target.Address(0, 0) Application.EnableEvents = False Case "D1" With Worksheets("Sheet2") LastR = .Range("A36636").End(xlUp).Row Set c = .Range("A1:A" & LastR).Find( _ Target.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True) If c Is Nothing Then If vbNo = MsgBox("リストに追加しますか?", _ vbYesNo, "追加の確認") Then Application.EnableEvents = True Exit Sub End If .Range("A" & LastR + 1).Value = Target.Value .Range("A1:A" & LastR + 1).Name = "リストA" End If With Target.Validation .Delete .Add Type:=xlValidateList, Formula1:="=リストA" .ShowError = False End With Case "E1" With Worksheets("Sheet2") Set c = .Range("B1:B" & LastR).Find( _ Target.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True) If c Is Nothing Then If vbNo = MsgBox("リストに追加しますか?", _ vbYesNo, "追加の確認") Then Application.EnableEvents = True Exit Sub End If .Range("B" & LastR + 1).Value = Target.Value .Range("B1:B" & LastR + 1).Name = "リストB" End If End Select End With With Target.Validation .Delete .Add Type:=xlValidateList, Formula1:="=リストB" .ShowError = False End With Application.EnableEvents = True End Sub

  • エクセル マクロ 初心者です

    エクセルマクロ初心者です。 以下の2つの Private Sub Worksheet_Change(ByVal Target As Range)を1つのシートで実行させたいのですが、 当方、初心者なので組み合わせ方が分かりません。 よろしくお願いします。 ===No1=== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target = StrConv(Target, vbUpperCase) Application.EnableEvents = True End Sub ===No2=== Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("コピーは禁止!!", vbCritical) MsgBox "データを消去します。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If If Target.Count = 1 Then Exit Sub Else MsgBox “複数セルのコピー禁止!" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub ------------ 上記の2つを1つのシートで動作させたいのですが、うまくいきません。 単体では、動作します。

  • セルの値をファイル名にするには

    現在下記のマクロを入力しています。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$10" Then Target.Offset(-6, 2).Value = Date End If End Sub この時 ファイル名を SHEET1のA1 セルの値を利用してファイル名にするために下記の内容を入れてブックを保存したいと考えています。 上記のマクロが入っていないときは上手く行くのですが下記を追加するにはどうすればいいかご指導いただけませんでしょうか。 宜しく御願いします。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 And Target.Column = 1 Then ActiveSheet.Name = Target.Value ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Target.Value End If End Sub

  • 「オブジェクトが必要です。」エラーになります。

    次のコードで2.は動くのですが、1.が動きません。「オブジェクトが必要です。」エラーになります。 何が違うんでしょうか? 教えてください。よろしくお願いします。 Function hoge(aa As Range) aa.Value = "Hello!!" End Function Sub Worksheet_Activate() Dim a As Range Set a = ThisWorkbook.Worksheets("Sheet1").Range("G10") hoge (a) ' ←1.これだとエラーになる ' hoge (ThisWorkbook.Worksheets("Sheet1").Range("G10")) ' 2.こちらはOK End Sub

  • (少数点、第三位から切り捨て)をこのマクロにどう入力すればいいですか??

    四捨五入を切捨て(第三位)するにはどうしたらいいのでしょうか?? VBAをちゃんと理解できていないので、誰か分かる人助けてください!! ついでにROUNDDOWNとかの関数はVBAに入力するコードとしては、 まったく別物なんでしょうか??初心者が生意気言ってすいません・・・。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Application.EnableEvents = False If Range(Target.Address).Column = 2 And _ Range(Target.Address).Row >= 5 And _ Range(Target.Address).Row <= 10 Then Range(Target.Address).Value = _ Range(Target.Address).Value / 19 End If Application.EnableEvents = True End Sub よろしくおねがいします・・。 カテゴリー間違えて入れなおしました。すみません・・。

  • 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~の処理はうまくいったので単純にコードをどんどん追加していけば動くと思ったんですが、いろいろ調べてもどうも方法がわからず進みません・・・ 解決してもらえるでしょうか・・