いつもお世話になっています。
色々しらべて試してみたんですが、うまくいかないんで教えてください。
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)については、まったくわかりません。
マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。
どなたか、教えてください。
お願いします。
No.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
>EからXに順に入力して・・・」の文の意味が、VBAで何かをして欲しいのか何もしないくていいのかわかりません。
どのセルから入力していくか、という説明が必要かと思い、書かせていただきました。
わかりにくいことを書いてしまい、申し訳ありませんでした。
こちらの回答で、思った通りのことができました。
本当にありがとうございました。
No.4
- 回答日時:
#2の回答者です。
>おっしゃる通りです。
というように反応されても、どういうイベントをさせるのか、コードの説明まで書いても、きちんちした説明をしていただけなったようです。私は、単に分からないということを伝えただけにすぎません。もともと、イベントを置くシートすら、明示されていません。
私は、他人のマクロをみて直すほど、みっともないことはしたくありませんが、どうやら、E4をイベントにしているようです。ただ、直接、お返事がいただけなかったということで、一応、こちらでは、訂正はせずに、そのまま様子見に切り替えさせていただきます。
それは、また、イベントですから、同種の違った種類のコードを入れることは、トラブルの元にもなります。
>(1)の処理に「もし、E4が空白だったら・・・・」の処理を入れればいいと思うのですが・・・。
If Range("E4").Value ="" Then
ということでも、それは、全体に関わる問題なのか、それとも、部分的なものなのか、はっきりしません。何か、同じ繰り返しになってしまうように思います。このような初歩的なマクロでは、きちんとした説明をまとめて、分かるようにしていただければ、長引くことはないはずです。
>このような初歩的なマクロでは、きちんとした説明をまとめて、分かるようにしていただければ、長引くことはないはずです。
自分のしたいことがうまくまとめられず、すいません。
不愉快な思いをさせていたら、申し訳ありません。
最初に回答をいただけて、嬉しかったです。
ありがとうございました。
No.3
- 回答日時:
一体いくつのシートを使っているのかわからないのですが、プログラムではこの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
回答、ありがとうございます。
>一体いくつのシートを使っているのかわからないのですが
文章がわかりづらく、すいません。
シートは、マクロがあるシート(△△)と、もう一枚(○○)の2枚です。
が、作っていただいたコードを転記したところ、希望道理の結果になりました。
ありがとうございます。
また、もうひとつ、お聞きしたいことがあるのですが・・・。
マクロがあるシート(△△)への入力は、4行目にE~X(左から右)へと順に入力していきます。
E4が空白のままで、H4に入力した際は、Y4にH4の値を入れたい場合は、どうすればいいですか?
最初の質問にないことで申し訳ないのですが、教えていただけますか?
(1)の処理に「もし、E4が空白だったら・・・・」の処理を入れればいいと思うのですが・・・。
申し訳ありません。
お願いします。
No.2
- 回答日時:
>(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
遅くなり、申し訳ありません。
回答、ありがとうございます。
>(3)
>また、(2)のイベントの他に、
>(1)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたいのですが・・・。
しかし、この文章が、(2)に連動しているのではなく、(1)側のマクロに連動しているのか、または、まったく別のキーのイベントというならは、これは、話が違います。思惑と違うというのは、説明が抜けているのかと思います。
おっしゃる通りです。
すいません。
(1)(2)(3)とも、値が変わった時、CHANGEイベントで発生させたいと思っておりました。
説明が足りず、申し訳ありませんでした。
No.1
- 回答日時:
私は、最後まで回答できないかもしれませんが、それだけはご了解ください。
私個人は、以下のような書き方はしませんが、一応、書き換えた部分は見てください。
細かな注意点を書こうかとは思いましたが、やめることにしました。
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
遅くなり、申し訳ありません。
回答、ありがとうございます。
元からあるVBAについても、きれいに書き直していただき、ありがとうございます。
(2)については、問題なく動きました。ありがとうございます。
ですが・・・。
(3)についてが、動きません。
もしよろしければ、教えていただきたいです。
よろしくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) [Excel VBA] このコードでは行の挿入や行の消去をすると13のエラーが出てしまう。 3 2022/12/09 00:29
- Excel(エクセル) B列に文字がはいったらA列に数字が入るマクロードを完成させたい 4 2023/04/21 01:58
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA 複数条件の分岐処理の上手...
-
VBA初心者 Ctrl+での操作、ボタ...
-
【VBA】マクロの入ったファイル...
-
Excel VBA 定義されたプロージ...
-
エクセルのマクロについて教え...
-
VB.net(VB)で、フォームにExcel...
-
エクセルのマクロについて教え...
-
【ExcelVBA】インデックスが有...
-
Excelで「Ctrl+c」、「Ctrl+v...
-
VBAに詳しい方教えてください。
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルVBAにて =A1=B1とすれ...
-
ExcelのVBAコードについて教え...
-
Excel VBAにて、2GB超の点群デ...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
ExcelのVBAです。フォルダ内の...
-
IEを使わないでhtmlテキストを...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBAのコードを教えてください
-
【ExcelVBA】インデックスが有...
-
ExcelVBA シート名を複数セルか...
-
エクセルvbaについて
-
エクセルのマクロについて教え...
-
【VBA】マクロの入ったファイル...
-
VBA UserFormからの転記で
-
エクセルVBAの配列について
-
Excelで「Ctrl+c」、「Ctrl+v...
-
VBAコードについて教えてくださ...
-
ExcelのVBAコードについて教え...
-
Excel マクロについての相談
-
VBAで質問があります
-
VBAコードについて
-
【ExcelVBA】VBA実行でダイアロ...
-
Excel関数またはVBAでの質問に...
-
ExcelのVBAコードについて教え...
-
ExcelのVBAコードについて教え...
-
ExcelのVBAコードについて教え...
-
Outlookの「受信日時」「件名」...
おすすめ情報