#2の回答者です。 >おっしゃる通りです。 というように反応されても、どういうイベントをさせるのか、コードの説明まで書いても、きちんちした説明をしていただけなったようです。私は、単に分からないということを伝えただけにすぎません。もともと、イベントを置くシートすら、明示されていません。 私は、他人のマクロをみて直すほど、みっともないことはしたくありませんが、どうやら、E4をイベントにしているようです。ただ、直接、お返事がいただけなかったということで、一応、こちらでは、訂正はせずに、そのまま様子見に切り替えさせていただきます。 それは、また、イベントですから、同種の違った種類のコードを入れることは、トラブルの元にもなります。 >(1)の処理に「もし、Ｅ４が空白だったら・・・・」の処理を入れればいいと思うのですが・・・。 If Range("E4").Value ="" Then ということでも、それは、全体に関わる問題なのか、それとも、部分的なものなのか、はっきりしません。何か、同じ繰り返しになってしまうように思います。このような初歩的なマクロでは、きちんとした説明をまとめて、分かるようにしていただければ、長引くことはないはずです。

一体いくつのシートを使っているのかわからないのですが、プログラムではこのVBAがあるシートと"○○"シートと"△△"シートの3枚のようだけれど、チェックしてデータを持ってくる"○○"シートと"△△"シートは同じシートでなければチェックの意味が無いような気もします。 一体いくつのシートを使っているのでしょう？ 一応３つのシートを使っていて、このVBAがあるシートをSheet1、"○○"シートをSheet2、"△△"シートをSheet3としています。 Private Sub Worksheet_Change(ByVal Target As Range) Worksheet_Change1 Target Worksheet_Change2 Target End Sub '(1)の処理 Sub Worksheet_Change1(ByVal Target As Range) Dim rng As Range '処理条件 '変更されたセルがH4セルで値があったら実行 (それ以外は終了) If Target.Address <> "$H$4" Then Exit Sub If Target.Value = "" Then Exit Sub '"○○"シート(Sheet2)のB列から探してなかったらエラーメッセージ出してH4選択 Set rng = Worksheets("Sheet2").Columns("B").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole) If rng Is Nothing Then MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" Range("h4").Value = "" Range("h4").Select Exit Sub End If '"△△"シート(Sheet2)のB列から探してあったらその行の値をコピー Set rng = Worksheets("Sheet3").Columns("B").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not rng Is Nothing Then Range("I4").Value = rng.Offset(0, 1).Value Range("j4").Value = rng.Offset(0, 2).Value Range("k4").Value = rng.Offset(0, 6).Value Range("l4").Value = rng.Offset(0, 7).Value Range("m4").Value = rng.Offset(0, 4).Value Range("K4").Select additional_event '転記した場合の追加イベント Else Range("h4").Value = "" Range("h4").Select End If End Sub '(2)の処理 Sub Worksheet_Change2(ByVal Target As Range) 'E4が変更されたとき If Target.Address <> "$E$4" Then Exit Sub '1ならE4を右に19移動したセル(X4)を☆ If Target.Value = "1" Then Range("X4") = "☆" additional_event '☆を書いた場合の追加イベント Else Range("X4") = "" End If End Sub '(3)の処理 Sub additional_event() '星を書いた場合の追加イベントif If Range("H4").Value = "" Then Exit Sub If Range("E4").Value <> "1" Then Exit Sub Range("Y4").Value = Range("H4").Value End Sub

>(3)についてが、動きません。 言葉の解釈通りなら、間違いないはずです。位置関係の問題だろうと思いますから、 以下のコードの説明を読んで修正してください。 動きませんと言われても、マクロは可動していますから、こちらでは確認できません。 >(3) >また、(2)のイベントの他に、 >(1)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたいのですが・・・。 しかし、この文章が、(2)に連動しているのではなく、(1)側のマクロに連動しているのか、または、まったく別のキーのイベントというならは、これは、話が違います。思惑と違うというのは、説明が抜けているのかと思います。 　　'E4を対象とする。 　ElseIf Not Intersect(Target, Range("E4")) Is Nothing Then　'(2) 　　　'E4 に1を入れる 　　If Target.Value = 1 Then　 　　　'X4に☆が入る 　　　Target.Offset(0, 19).Value = "☆" 　　　'もし、H4に値が入っていれば、 　　　If Target.Offset(0, 3).Value <> "" Then　'(3)　 　　　'Y4にH4の値が入る 　　　　Target.Offset(0, 20).Value = Target.Offset(0, 3).Value 　　　End If 　　End If 　End If

私は、最後まで回答できないかもしれませんが、それだけはご了解ください。 私個人は、以下のような書き方はしませんが、一応、書き換えた部分は見てください。 細かな注意点を書こうかとは思いましたが、やめることにしました。 If Target.Count > 1 Then Exit Sub これは、その目的の意味にもよりますが、通常、Changeイベントにするなら、先頭においてもよいかと思います。本来は、それとともに、その次の行に、If Target.Value ="" Then Exit を入れます。 おそらく、「実は、これはH列とE列を対象にしています」というかもしれませんが、それは、なるべくご自身で考えてください。ある程度は対応するように考えています。 '// Private Sub Worksheet_Change(ByVal Target As Range) 　'Dim rang3 As Range '不要 　Dim rang4 As Range 　Dim rang5 As Range '加入 　Dim sText As Variant 　'Dim LastRow1 As Long　'不要 　If Target.Count > 1 Then Exit Sub 　Application.EnableEvents = False 　If Not Intersect(Target, Range("H4")) Is Nothing Then 　　With Worksheets("○○") 　　　Set rang4 = .Range("B1", .Cells(Rows.Count, "B").End(xlUp).Offset(, 7)) 　　End With 　　On Error Resume Next 　　sText = WorksheetFunction.VLookup(Target.Value, rang4, 2, 0) 　　If Err.Number > 0 Then 　　　MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" 　　　Range("H4").Select 　　　Set rang4 = Nothing 　　Else 　　 With Worksheets("△△") 　　　　 Set rang5 = .Range("B1", .Cells(Rows.Count, "B").End(xlUp).Offset(, 7)) 　　 End With 　　　Range("J4").Value = WorksheetFunction.VLookup(Target.Value, rang5, 3, False) 　　　Range("K4").Value = WorksheetFunction.VLookup(Target.Value, rang5, 7, False) 　　　Range("L4").Value = WorksheetFunction.VLookup(Target.Value, rang5, 8, False) 　　　Range("M4").Value = WorksheetFunction.VLookup(Target.Value, rang5, 5, False) 　　　Range("K4").Select 　　　Set rang5 = Nothing 　　End If 　ElseIf Not Intersect(Target, Range("E4")) Is Nothing Then　'(2) 　　If Target.Value = 1 Then 　　　Target.Offset(0, 19).Value = "☆" 　　　If Target.Offset(0, 3).Value <> "" Then　'(3) 　　　　Target.Offset(0, 20).Value = Target.Offset(0, 3).Value 　　　End If 　　End If 　End If 　Application.EnableEvents = True End Sub