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

質問

エクセル２００３でマクロを組んでいます。

Sheet1,Sheet2の２つのシートがあり、
片方のシートの"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モジュールを繰り返したコードもありました。）

よろしくお願いします。

回答No.3

Wendy02 · ベストアンサー

補足：

>今考えうる「全て」は、値、フォントの色、セル背景色、罫線です。
もし、フォントの色、セルの背景色、罫線のイベントで取ろうとしたら、インスタンスを作らないといけないので、かなり長いコードになるし、まったく発想が違います。今の延長上ではありませんから、これ以上の方法を願うのでしたら、「作業グループ」を取ってください。

例：
　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

お礼

回答ありがとうございます。
返信が遅れて申し訳ありません。

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

回答No.2

Wendy02

こんばんは。

>『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

こんにちは。

ご質問者さんの、その　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列は青で塗る
の２点です。

例えば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　のコードがちょっとヘンですね。
すみません、絶対の自信があるわけじゃないのですが、
できればどうヘンなのか教えていただけないでしょうか。

よろしくお願いします。