重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら>

【GOLF me!】初月無料お試し

いつもお世話になっています。

色々しらべて試してみたんですが、うまくいかないんで教えてください。


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)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたいのですが・・・。



(2)のみなら動くことは確認できましたが、(1)のexit sub の直前に入れたり、end ifの前に入れたりしましたが、片方は動くが、もうひとつが動かないです。
(3)については、まったくわかりません。

マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。


どなたか、教えてください。
お願いします。

A 回答 (5件)

No.3です。


こんなのでしょうか?
参照する"△△"シートを"Sheet2"としています。
>マクロがあるシート(△△)への入力は、4行目にE~X(左から右)へと順に入力していきます。
>E4が空白のままで、H4に入力した際は、Y4にH4の値を入れたい場合は、どうすればいいですか?
E4またはH4が変更された時にY4を変更する条件と値はわかりましたが、その前の「EからXに順に入力して・・・」の文の意味が、VBAで何かをして欲しいのか何もしないくていいのかわかりません。

それとシートの値を変更する条件が増えてゆくと、条件によってはWorksheet_Changeが多重にかかる場合が起きてくるので、今は不要ですが、Application.EnableEventsでの制御が必要になってくる可能性が出てくるかもしれません。


Private Sub Worksheet_Change(ByVal Target As Range)
changeH4 Target
changeE4 Target
End Sub

'(1)の処理
Sub changeH4(ByVal Target As Range)
Dim rng As Range
'処理条件
'変更されたセルがH4セルで値があったら実行 (それ以外は終了)
If Target.Address <> "$H$4" Then Exit Sub 'H4以外のchangeイベントなら終了
If Target.Value <> "" Then '空白でなく
'"△△"シート(Sheet2)のB列から探してなかったらエラーメッセージ出してH4選択
Set rng = Worksheets("Sheet2").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
checkY4 '転記した場合の追加イベント
Exit Sub
End If
MsgBox Target.Value & "はありません。基本情報台帳に入力してください。"
End If
Range("H4:M4").Value = ""
Range("H4").Select
End Sub

'(2)の処理
Sub changeE4(ByVal Target As Range)
'E4が変更されたとき
If Target.Address <> "$E$4" Then Exit Sub
'1ならE4を右に19移動したセル(X4)を☆
If Target.Value = "1" Then
Range("X4") = "☆"
checkY4 '☆を書いた場合の追加イベント
Else
Range("X4") = ""
End If
End Sub

'(3)の処理
Sub checkY4()
Dim y4 As String
y4 = ""
'(1)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたい。
If Range("H4").Value <> "" Then
If Range("E4").Value = "1" Then
y4 = Range("H4").Value
End If
End If
'E4が空白のままで、H4に入力した際は、Y4にH4の値を入れたい場合
If Range("E4").Value = "" Then
If Range("H4").Value <> "" Then
y4 = Range("H4").Value
End If
End If
Range("Y4").Value = y4
End Sub
    • good
    • 0
この回答へのお礼

>EからXに順に入力して・・・」の文の意味が、VBAで何かをして欲しいのか何もしないくていいのかわかりません。

どのセルから入力していくか、という説明が必要かと思い、書かせていただきました。
わかりにくいことを書いてしまい、申し訳ありませんでした。

こちらの回答で、思った通りのことができました。
本当にありがとうございました。

お礼日時:2010/12/22 21:07

#2の回答者です。



>おっしゃる通りです。
というように反応されても、どういうイベントをさせるのか、コードの説明まで書いても、きちんちした説明をしていただけなったようです。私は、単に分からないということを伝えただけにすぎません。もともと、イベントを置くシートすら、明示されていません。

私は、他人のマクロをみて直すほど、みっともないことはしたくありませんが、どうやら、E4をイベントにしているようです。ただ、直接、お返事がいただけなかったということで、一応、こちらでは、訂正はせずに、そのまま様子見に切り替えさせていただきます。

それは、また、イベントですから、同種の違った種類のコードを入れることは、トラブルの元にもなります。

>(1)の処理に「もし、E4が空白だったら・・・・」の処理を入れればいいと思うのですが・・・。
If Range("E4").Value ="" Then

ということでも、それは、全体に関わる問題なのか、それとも、部分的なものなのか、はっきりしません。何か、同じ繰り返しになってしまうように思います。このような初歩的なマクロでは、きちんとした説明をまとめて、分かるようにしていただければ、長引くことはないはずです。
    • good
    • 0
この回答へのお礼

>このような初歩的なマクロでは、きちんとした説明をまとめて、分かるようにしていただければ、長引くことはないはずです。

自分のしたいことがうまくまとめられず、すいません。

不愉快な思いをさせていたら、申し訳ありません。
最初に回答をいただけて、嬉しかったです。
ありがとうございました。

お礼日時:2010/12/22 20:48

一体いくつのシートを使っているのかわからないのですが、プログラムではこのVBAがあるシートと"○○"シートと"△△"シートの3枚のようだけれど、チェックしてデータを持ってくる"○○"シートと"△△"シートは同じシートでなければチェックの意味が無いような気もします。


一体いくつのシートを使っているのでしょう?
一応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
    • good
    • 0
この回答へのお礼

回答、ありがとうございます。

>一体いくつのシートを使っているのかわからないのですが

文章がわかりづらく、すいません。

シートは、マクロがあるシート(△△)と、もう一枚(○○)の2枚です。
が、作っていただいたコードを転記したところ、希望道理の結果になりました。

ありがとうございます。


また、もうひとつ、お聞きしたいことがあるのですが・・・。

マクロがあるシート(△△)への入力は、4行目にE~X(左から右)へと順に入力していきます。
E4が空白のままで、H4に入力した際は、Y4にH4の値を入れたい場合は、どうすればいいですか?

最初の質問にないことで申し訳ないのですが、教えていただけますか?

(1)の処理に「もし、E4が空白だったら・・・・」の処理を入れればいいと思うのですが・・・。

申し訳ありません。
お願いします。

お礼日時:2010/12/21 12:29

>(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
    • good
    • 0
この回答へのお礼

遅くなり、申し訳ありません。
回答、ありがとうございます。

>(3)
>また、(2)のイベントの他に、
>(1)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたいのですが・・・。

しかし、この文章が、(2)に連動しているのではなく、(1)側のマクロに連動しているのか、または、まったく別のキーのイベントというならは、これは、話が違います。思惑と違うというのは、説明が抜けているのかと思います。

おっしゃる通りです。
すいません。

(1)(2)(3)とも、値が変わった時、CHANGEイベントで発生させたいと思っておりました。
説明が足りず、申し訳ありませんでした。

お礼日時:2010/12/21 12:04

私は、最後まで回答できないかもしれませんが、それだけはご了解ください。


私個人は、以下のような書き方はしませんが、一応、書き換えた部分は見てください。
細かな注意点を書こうかとは思いましたが、やめることにしました。

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

この回答への補足

ありがとうございます。
後ほど、確認の上、報告させていただきます。

補足日時:2010/12/20 10:04
    • good
    • 0
この回答へのお礼

遅くなり、申し訳ありません。
回答、ありがとうございます。

元からあるVBAについても、きれいに書き直していただき、ありがとうございます。


(2)については、問題なく動きました。ありがとうございます。

ですが・・・。
(3)についてが、動きません。


もしよろしければ、教えていただきたいです。

 よろしくお願い致します。

お礼日時:2010/12/20 17:00

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

今、見られている記事はコレ!