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

Question

エクセル２００３でマクロを組んでいます。

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モジュールを繰り返したコードもありました。）

よろしくお願いします。

Wendy02 · Accepted Answer

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

Wendy02 · Answer

こんばんは。

>『Sheet1と2において指定した範囲の全ての同期を取る』です。
>今考えうる「全て」は、値、フォントの色、セル背景色、罫線です。

なるべく、最初から、そういうことは書いていただいたほうがよいですね。あまり後出しの条件が多いと、書いてきた全ての内容がひっくり返ってしまうことがあります。

最初に書かなかったけれども、最初から同期を取る目的なら、二つのシートを作業グループにしたほうが早いです。それで全てが済むはずです。最初、掲示する前に、そういうマクロを書いたけれども、趣旨が違うと思って載せませんでした。

マクロのマクロのような方法は、難しくなるだけだと思います。

>すみません、絶対の自信があるわけじゃないのですが、
>できればどうヘンなのか教えていただけないでしょうか。

>Sh_name = ActiveSheet.Name
>Set r = Intersect(Target, Range("A4:G10"))

そういうコードを回答者の中でも書く人がいますが、引数がきちんと捕らえられていないと思います。

引数、Sh は、ActiveSheet だからですし、

Intersect(Target, Range("A4:G10"))
シートの指定がない前の確実性がない時に、Intersect の戻り値を　Range オブジェクトを変数に代入しているけれど、単に、範囲のチェッカーだけに使えばよいと思います。それと、引数　Target で取得しているのだから、それを使えば済むわけです。

Wendy02 · Answer

こんにちは。

ご質問者さんの、その　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

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

補足：

こんばんは。

こんにちは。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング