こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

エクセル2003でマクロを組んでいます。

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

よろしくお願いします。

投稿日時 - 2007-08-25 16:43:33

QNo.3285462

暇なときに回答ください

質問者が選んだベストアンサー

補足:

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

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

投稿日時 - 2007-08-26 02:24:33

お礼

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

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

投稿日時 - 2007-08-29 09:42:17

ANo.3

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

こんばんは。

>『Sheet1と2において指定した範囲の全ての同期を取る』です。
>今考えうる「全て」は、値、フォントの色、セル背景色、罫線です。

なるべく、最初から、そういうことは書いていただいたほうがよいですね。あまり後出しの条件が多いと、書いてきた全ての内容がひっくり返ってしまうことがあります。

最初に書かなかったけれども、最初から同期を取る目的なら、二つのシートを作業グループにしたほうが早いです。それで全てが済むはずです。最初、掲示する前に、そういうマクロを書いたけれども、趣旨が違うと思って載せませんでした。

マクロのマクロのような方法は、難しくなるだけだと思います。

>すみません、絶対の自信があるわけじゃないのですが、
>できればどうヘンなのか教えていただけないでしょうか。

>Sh_name = ActiveSheet.Name
>Set r = Intersect(Target, Range("A4:G10"))

そういうコードを回答者の中でも書く人がいますが、引数がきちんと捕らえられていないと思います。

引数、Sh は、ActiveSheet だからですし、

Intersect(Target, Range("A4:G10"))
シートの指定がない前の確実性がない時に、Intersect の戻り値を Range オブジェクトを変数に代入しているけれど、単に、範囲のチェッカーだけに使えばよいと思います。それと、引数 Target で取得しているのだから、それを使えば済むわけです。

投稿日時 - 2007-08-26 01:33:42

お礼

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

>二つのシートを作業グループにしたほうが早いです。
「シートを作業グループにする」という記述があるのですね、「マクロの記録」でしっかり記録できました。
(Arrayを使ってシート数分やってるだけみたいですけど)
これも使ってみようと思います。

>>できればどうヘンなのか教えていただけないでしょうか。
>引数がきちんと捕らえられていないと思います。
正直まだ理解できないようです、聞いておいて申し訳ありません。
Sh.nameで入力したシート名が手に入ることだけはわかりました。

投稿日時 - 2007-08-29 09:34:05

ANo.1

こんにちは。

ご質問者さんの、その 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
  
  

投稿日時 - 2007-08-25 18:42:26

補足

いつも回答ありがとうございます。
申し訳ありません、ちょっと説明不足でした。

「同時に生かしたい」と書いたのは、
 ・各シートにおいてA4:G10の範囲の値について同期を取る
 ・各シートのA列に値が入ったら同行のC列は青で塗る
の2点です。

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

よろしくお願いします。

投稿日時 - 2007-08-26 01:06:30

あなたにオススメの質問