ExcelのVBAで教えてください。

質問

Private Sub Worksheet_Changeについて教えて下さい。

まず初歩的なご質問ですが、Private Sub Worksheet_Changeを1つのシートモジュールに1個以上組むことは可能なのでしょうか？

例えばネットで以下のようにsheet1に

Private Sub Worksheet_Change

Private Sub Worksheet_Change_1

_1を付けてるのを見たことがあったので試してみましたが動作しませんでした。

今回行いたいのは1つが、指定したセルが変更されると次の指定セルに移動する。
以下がマクロです。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Address(0, 0)
Case "E14"
[E15].Select
Case "E15"
[E26].Select
Case "E26"
[E22].Select
Case "E22"
[E25].Select
Case "E25"
[E29].Select
Case "E29"
[E20].Select
Case "E20"
[E21].Select
Case "E21"
[E16].Select
Case "E16"
[E17].Select
Case "E17"
[E27].Select
Case "E27"
[E23].Select
Case "E23"
[E24].Select
Case "E24"
[E28].Select
Case "E28"
[E18].Select
Case "E18"
[E19].Select

End Select
End Sub

もう一つが、あるセルに数値をいれると他のブックのシートからそのシートの指定した行のセルの
数値を読み込んできて、元のブックのシートに数値を書き込むといったもです。
以下がマクロです。

Private Sub Worksheet_Change_1(ByVal Target As Excel.Range)
Dim w As Workbook
Dim c As Range
On Error Resume Next
Set xCur = Selection

If Application.Intersect(Target, Range("F3")) Is Nothing Then Exit Sub
If Range("F3") = "" Then Exit Sub

Application.ScreenUpdating = False

'転記元のブックを開いて逆順で検索する
Set w = Workbooks.Open("V:\新３係（ＦＩＡ・ｉＰｏｔ）\(2)新４係（ｉＰｏｔ）\ipot進捗\履歴管理\(9)KBB39360　X8 imm1.35 Ｇ１履歴、本体履歴　.xls")
Set c = w.Worksheets("対物").Range("B:B").Find(what:=Range("F3").Value, LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlPrevious)

'見つけた（一番下の）セルを基準に転記する
If Not c Is Nothing Then
Range("F4").Value = c.Offset(0, 1).Value

End If
w.Close False

Application.ScreenUpdating = True

End Sub

ともに1つずつなら問題なく動作するのですが、2個のマクロを組むと片方しか動作しません。
多分ものすごく初歩的な事だとは思いますが、御指導の程宜しくお願いします。

回答No.1

neKo_quatre · ベストアンサー

Private Sub Worksheet_Changeから、別の２つの処理(ここでは仮にSubProc1とSubProc2という関数名)を呼び出すような書き方が良いと思います。

' ワークシート変更時にExcelから呼び出されるイベントプロシージャ
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　　' 処理1を呼び出し
　　Call SubProc1(Target)
　　' 処理2を呼び出し
　　Call SubProc2(Target)
End Sub

' 処理1 指定したセルが変更されると次の指定セルに移動する。
Private Sub SubProc1(ByVal Target As Excel.Range)
　Select Case Target.Address(0, 0)
　Case "E14"
　　[E15].Select
　Case "E15"
　　[E26].Select
　～
　End Select
End Sub

' 処理2 あるセルに数値をいれると他のブックのシートからそのシートの指定した行のセルの数値を読み込んできて、元のブックのシートに数値を書き込む
Private Sub SubProc2(ByVal Target As Excel.Range)
　Dim w As Workbook
　Dim c As Range
　On Error Resume Next
　Set xCur = Selection

　If Application.Intersect(Target, Range("F3")) Is Nothing Then Exit Sub
　If Range("F3") = "" Then Exit Sub
　～
End Sub

--
> まず初歩的なご質問ですが、Private Sub Worksheet_Changeを1つのシートモジュールに1個以上組むことは可能なのでしょうか？

１個は組み込めるので可能ってことになりますが。
同名の関数は２つ作れません。
Excelはワークシートが変更された際に、Worksheet_Changeを呼び出します。

> _1を付けてるのを見たことがあったので試してみましたが動作しませんでした。

確認できないので分かりませんが、Worksheet_Changeの中からWorksheet_Change_1を呼び出しているのでは。

お礼

ありがとうございます。
目的通りの事ができました。
ベストアンサーとさせて頂きます。

回答No.4

kagakusuki

>Private Sub Worksheet_Changeを1つのシートモジュールに1個以上組む

という考え方で、回答No.1様の様な方法を使うのが、正当な方法だと思います。
　只、御質問の件の場合、1つ目のマクロの方は指定されたセルを選択するというものであるのに対し、2つ目のマクロの方はデータを転記するというもので、マクロが記述されているブックにおいて選択されているセルが変更される事はないのですから、どちらか片方の処理を終えた後でもう一方の方の処理を行う様にされれば良いのではないでしょうか?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim w As Workbook
Dim c As Range

Application.ScreenUpdating = False

Select Case Target.Address(0, 0)
Case "E14"
Raneg("E15").Select
Case "E15"
Raneg("E26").Select
Case "E26"
Raneg("E22").Select
Case "E22"
Raneg("E25").Select
Case "E25"
Raneg("E29").Select
Case "E29"
Raneg("E20").Select
Case "E20"
Raneg("E21").Select
Case "E21"
Raneg("E16").Select
Case "E16"
Raneg("E17").Select
Case "E17"
Raneg("E27").Select
Case "E27"
Raneg("E23").Select
Case "E23"
Raneg("E24").Select
Case "E24"
Raneg("E28").Select
Case "E28"
Raneg("E18").Select
Case "E18"
Raneg("E19").Select

End Select

On Error Resume Next
Set xCur = Selection

If Application.Intersect(Target, Range("F3")) Is Nothing Then Exit Sub
If Range("F3") = "" Then Exit Sub

'転記元のブックを開いて逆順で検索する
Set w = Workbooks.Open("V:\新３係（ＦＩＡ・ｉＰｏｔ）\(2)新４係（ｉＰｏｔ）\ipot進捗\履歴管理\(9)KBB39360　X8 imm1.35 Ｇ１履歴、本体履歴　.xls")
Set c = w.Worksheets("対物").Range("B:B").Find(what:=Range("F3").Value, LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlPrevious)

'見つけた（一番下の）セルを基準に転記する
If Not c Is Nothing Then
Range("F4").Value = c.Offset(0, 1).Value

End If
w.Close False

Application.ScreenUpdating = True

End Sub

　もしくは、2つ目のマクロの中の

Exit Sub

を同マクロの末尾の

w.Close False

よりも後にジャンプするGoToステートメントに置き換えて、2つ目のマクロの処理の方を先にする事も出来ます。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim w As Workbook
Dim c As Range
On Error Resume Next
Set xCur = Selection

If Application.Intersect(Target, Range("F3")) Is Nothing Then Goto label1
If Range("F3") = "" Then Goto label1

Application.ScreenUpdating = False

'転記元のブックを開いて逆順で検索する
Set w = Workbooks.Open("V:\新３係（ＦＩＡ・ｉＰｏｔ）\(2)新４係（ｉＰｏｔ）\ipot進捗\履歴管理\(9)KBB39360　X8 imm1.35 Ｇ１履歴、本体履歴　.xls")
Set c = w.Worksheets("対物").Range("B:B").Find(what:=Range("F3").Value, LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlPrevious)

'見つけた（一番下の）セルを基準に転記する
If Not c Is Nothing Then
Range("F4").Value = c.Offset(0, 1).Value

End If
w.Close False

label1:
Select Case Target.Address(0, 0)
Case "E14"
Raneg("E15").Select
Case "E15"
Raneg("E26").Select
Case "E26"
Raneg("E22").Select
Case "E22"
Raneg("E25").Select
Case "E25"
Raneg("E29").Select
Case "E29"
Raneg("E20").Select
Case "E20"
Raneg("E21").Select
Case "E21"
Raneg("E16").Select
Case "E16"
Raneg("E17").Select
Case "E17"
Raneg("E27").Select
Case "E27"
Raneg("E23").Select
Case "E23"
Raneg("E24").Select
Case "E24"
Raneg("E28").Select
Case "E28"
Raneg("E18").Select
Case "E18"
Raneg("E19").Select

End Select

Application.ScreenUpdating = True

End Sub

　尚、2つ目のマクロの中にある

Set xCur = Selection

という箇所が、一体何のためにあるのかという事と、Selectionというのが1つ目のマクロで処理する前に選択されていたセル範囲の事なのか、それとも1つ目のマクロで処理する事によって新たに選択されたセル範囲の事であるのかが解りませんでしたので、取り敢えずその部分は何もいじらずにそのままにしております。

　後、余談ですが、

Select Case Target.Address(0, 0)

で条件分岐させるという方法では、例えば他のセルをコピーしてE13:E15のセル範囲に貼り付ける事によって、E14セルやE15セルの値を変更させた場合には、

Address(0, 0)

の部分が返す値は

"E13:E15"

となってしまい、

"E14"

や

"E15"

ではないため、セルの選択が変更されない事になりますが、それで宜しいのでしょうか?
　もしその様なやり方でセルの値が変更された場合にも、セルの選択を変更する必要があるのであれば、上記の例におけるE14セルとE15セルの様に、複数のセルの値が変更された場合には、どのセル(E15?　E26?　それともその両方?)を選択する様にした方が良いのでしょうか?

お礼

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

今回Ｎｏ．1の御回答が求めていた形でしたので、そちらをベストアンサーにさせて頂きました。

しかしながらkagakusukiさんの御回答もいつも丁寧に色々とお答え頂きありがとうございます。

今後ともよろしくお願いします。

回答No.3

real beatin（@realbeatin）

＃２です。

誤）
> ひとつのモジュールでは、ひとつのイベントについてひとつのモジュール、
> というのが鉄則です（他のクラスを使うなら可能ですが混乱の元です）。
正）
　ひとつのモジュールでは、ひとつのイベントについてひとつの【プロシージャ】、
　というのが鉄則です（他のクラスを使うなら可能ですが混乱の元です）。

以上、訂正をお願いします。

回答No.2

real beatin（@realbeatin）

こんにちは。

> まず初歩的なご質問ですが、Private Sub Worksheet_Changeを1つのシートモジュールに1個以上組むことは可能なのでしょうか？
「1つのシートモジュールに」ということでしたら、不可能です。
ひとつのモジュールでは、ひとつのイベントについてひとつのモジュール、
というのが鉄則です（他のクラスを使うなら可能ですが混乱の元です）。
ＶＢＡでは、不要なTargetならすぐに処理を抜けるような形でロスを少なくするように、
普通は、１つのイベントプロシージャプロシージャに複数の処理を書き分けます。

まず、
　　If Application.Intersect(Target, Range("E14:E18,E20:E29,F3")) Is Nothing Then Exit Sub
という記述でTargetを篩に掛けます。
次にTargetが、Ｅ列なのかＦ列なのか、で処理を分岐します。
後は処理するだけです。

いくつかの記述に修正を加えていますが、
非推奨の記法を推奨されるものに換えている箇所を★で示します。
すでに取得されているセル範囲=Target、については、
すべてTargetで統一して、無駄な参照をなくしてあります。
変数にする必要のないものはWithステートメントでブロック化しています。
E14→E15、などのセル移動の規則については、
CollectionオブジェクトやDictionary、配列変数などを用いて、
条件分岐を単純化することは可能ですが、
パッと見て解り易い記述を選ぶのが吉、と思います。
> [E15].Select
のような記述は、名前ボックスへのショートカットですが、
最近では（少なくとも公の場では）まず使われることのない記述です。
パフォーマンス的にもロス（オーバーヘッド）が多いので、
提示するようにCellsを用いるのが奨められます。
Cellsが苦手ならまだしもRange、解り易い方でどうぞ。

' ' ///

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range
'　　If Target.Count > 1 Then Exit Sub　'　E14:E18,E20:E29が結合セルでない場合は　イキ
　　If Target(1).Value = "" Then Exit Sub
　　If Application.Intersect(Target, Range("E14:E18,E20:E29,F3")) Is Nothing Then Exit Sub

　　Select Case Target.Column

　　Case 5　'　E列相当
　　' ' 指定したセルが変更されると次の指定セルに移動する。
　　　　Select Case Target.Address(0, 0)
　　　　Case "E14":　　Cells(15, "E").Select　'　★　↓
　　　　Case "E15":　　Cells(26, "E").Select
　　　　Case "E16":　　Cells(17, "E").Select
　　　　Case "E17":　　Cells(27, "E").Select
　　　　Case "E18":　　Cells(19, "E").Select
　　　　Case "E20":　　Cells(21, "E").Select
　　　　Case "E21":　　Cells(16, "E").Select
　　　　Case "E22":　　Cells(25, "E").Select
　　　　Case "E23":　　Cells(24, "E").Select
　　　　Case "E24":　　Cells(28, "E").Select
　　　　Case "E25":　　Cells(29, "E").Select
　　　　Case "E26":　　Cells(22, "E").Select
　　　　Case "E27":　　Cells(23, "E").Select
　　　　Case "E28":　　Cells(18, "E").Select
　　　　Case "E29":　　Cells(20, "E").Select　'　★　↑
　　　　End Select

　　Case 6　'　F列相当
　　' ' 他のブックのシートからそのシートの指定した行のセルの数値を読み込んできて、元のブックのシートに数値を書き込む
　　　　Application.ScreenUpdating = False
　　　　'転記元のブックを開いて逆順で検索する
　　　　With Workbooks.Open("V:\新３係（ＦＩＡ・ｉＰｏｔ）\(2)新４係（ｉＰｏｔ）\ipot進捗\履歴管理\(9)KBB39360　X8 imm1.35 Ｇ１履歴、本体履歴　.xls")
　　　　　　Set c = .Worksheets("対物").Range("B:B").Find( _
　　　　　　　　What:=Target.Value, _
　　　　　　　　LookIn:=xlValues, _
　　　　　　　　LookAt:=xlPart, _
　　　　　　　　SearchDirection:=xlPrevious)
　　　　　　'見つけた（一番下の）セルを基準に転記する
　　　　　　If Not c Is Nothing Then
　　　　　　　　Application.EnableEvents = False　'　★
　　　　　　　　Range("F4").Value = c.Offset(0, 1).Value
　　　　　　　　Application.EnableEvents = True　'　★
　　　　　　　　Set c = Nothing
　　　　　　End If
　　　　　　.Close False
　　　　End With
　　　　Application.ScreenUpdating = True
　　End Select
End Sub

お礼

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

今回Ｎｏ．1の御回答が求めていた形でしたので、そちらをベストアンサーにさせて頂きましたが、realbeatinさんの御回答も大変ご参考になりました。

今後ともよろしくお願いします。