【Excel VBA】ThisWorkbook モジュールのマクロ

質問

Excel2003を使用しています。

39枚のシートから成るBook1のThisWorkbook モジュールに、C列に“○月計”と入力されたら、その行のE列、F列、G列へ数式を入力するコードを書いています。

現在は、それぞれのシート(39枚のシートのうち3枚を除く36枚)のC列最終行から2行下のセルへ“○月計”と手入力していますが、マクロで“○月計”と入力されるようにすれば、ThisWorkbook モジュールに書いているコードも実行されて、数式の入力までマクロで処理できるのかな？と思い、試しに、36枚それぞれシートのC列最終行から2行下のセルへ“○月計”と入力されるようコードを書いてみました。

…が、そうではないのか、それぞれのシートのC列最終行から2行下のセルへ“○月計”と入力されるものの、E列、F列、G列へ数式は入力されません。

せっかくなので、できることなら数式の入力までマクロで処理したいのですが、どのようにしたらThisWorkbook モジュールに書いているコードまで実行されるのでしょうか？
よろしくお願いします。

回答No.3

fujillin · ベストアンサー

No2です。

＜方法1＞
（No1様の回答の前半の方法）
・Macro1の処理内（End Withの前）に、 Workbook_SheetChangeの処理
　内容をそのまま入れてしまう。（コピペでも良い）
・そのままだと処理がうまくつながらないので、データの受け渡し部分
　を修正。
　Dim shName As String
　shName = Sh.Name
　　　　↓
　Dim shName As String, Target as Range
　shName = .Name
　Set Target = .Cells(LastR, "C")
みたいな感じ。

＜方法2＞
（No2の回答内容：基本的には方法1と同じ）
・Private Sub Workbook_SheetChangeはイベント用サブルーチン名の
　予約語なので、別の適当な名に変更する。（例えば： Sub Test)
・Macro1のループ内から<方法1＞でコードをコピペした変わりに、↑の
　Sub Testを呼び出すようにする。
　Call Test(Worksheets(shNum), .Cells(LastR, "C"))

注）
1）もしもMacro1が、ThisWorkbookモジュール以外にある場合は＜方法2＞
　のままではサブルーチンコールができません。
　Macro1をThisWorkbookモジュールに移動するか、Testを標準モジュール
　に移動します。
　TestとMacro1が同じモジュール内にあるならそのままでOKですが、
　違うモジュールにおく場合（Module1とModule2など）、はTestの前の
　Private宣言をはずしてください。
2）Targetは多分予約語ではないと思いますが（未確認）、できれば他の
　変数名にしておいた方が安全かも…

お礼

再びアドバイスをいただけて嬉しいです♪
ありがとうございます！

今回は、＜方法2＞で…と思っていましたが、呼び出し方が悪いのか、うまくいきませんでしたので、＜方法1＞で元のThisWorkbook モジュールのコードをMacro1のコード内へコピペする方法にしました。

とりあえず、希望通り動作するのですが、マクロを実行時、アクティブにしていたシートに、それぞれのシートのデータ入力最終行から2行下へ入力された数式が同行に入力されてしまいます。
(例えば、Sheet1の数式入力行が10行目、Sheet2が13行目だった場合、アクティブにしていたシートの10行目と13行目にも数式が入力される)

なので、マクロ実行時にアクティブにしていたシートには、ループしたシート数分、マクロで数式が入力された行に同じ数式が入力されてしまう状況です。

元のBook をコピーしたものでテストしていましたし、たまたまあまり支障のないシートをアクティブにしていたのでよかったのですが、できれば、上記の状況を改善したいです。
原因としては、どういったことが考えられるでしょうか？
重ねての質問となり恐れ入りますが、よろしくお願いします。

回答No.5

imogasi

#4です。
＞他のBook からの貼り付けたデータシート等も含まれており、全シート処理は避けたほうがいいかと
ー
For　Nextでも、
除外するシートをスキップしたら仕舞いでしょう。
私の例でも
If Sh.Name <> "Sheet1" Then '除外シートの除外
とわざわざ１つは除外して、例の一片を示したつもりです。
数シートならIfとORで除外シート名の該当を探し、より分けるとか、除外シート名のArrayをつくるとかで１０シートぐらいまでなら、不細工なコードにならず出来ると思う。

お礼

何度もありがとうございます。

No.4で記載していただいたコード例ももちろん拝見しましたが、今回はFor … Next で処理することとしたまでで、元々、For … Next でコードを書いていたので、それをそのまま利用することにしたのです。

時間があるときにでも、アドバイスいただいた方法で、勉強がてらコードを書いてみようと思います。
わざわざ、ありがとうございました。

回答No.4

imogasi

>最終行から2行下のセルへ“○月計”と手入力していますが
入力データの最終行の２行下でしょうね。
＞C列に“○月計”と入力されたら
はチェンジされたセルがC列で、そのセルの値が“○月計”なら、同行のE,F,Gに数式を入れる。これはたやすい。
ーーー
しかし
列に“○月計”をVBAで入れるなら、データの入力が今終わったと言う、終わりと言うシグナルが何か必要なのはプログラマで在れば判るでしょう。それをどう考えているのか。普通はコマンドボタン等のクリックなどでシグナルをもらうが、シートが多いとコントロールの貼り付けとかコードが複雑になる。
ーーー
Deactivateで考えてみた
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
MsgBox Sh.Name
If Sh.Name <> "Sheet1" Then '除外シートの除外
d = Sh.Range("A65536").End(xlUp).Row 'C列にしたほうがよいかも
MsgBox d
Sh.Cells(d + 2, "C") = Sh.Name & "CC" 'ここは本当は数式。以下同
Sh.Cells(d + 2, "D") = Sh.Name & "DD"
Sh.Cells(d + 2, "E") = Sh.Name & "EE"
Sh.Cells(d + 2, "F") = Sh.Name & "FF"
End If
End Sub
ーーーー
しかしこれだと、入力が全シート終わってから、全シート対象に処理をバッチ的に走らすのと変わらないことも有る。
バッチ的に全シート処理は、For Each Sh In Worksheetsで簡単。
ーー
コードを考える前に仕組みを考えないと。

お礼

アドバイスありがとうございます。

For Each Sh In Worksheets での処理も考えなくはなかったのですが、他のBook からの貼り付けたデータシート等も含まれており、全シート処理は避けたほうがいいかと思い、For … Next での処理にしました。

ここでアドバイスをいただきながら、何とかコードを完成させることができる程度で、プログラマなどではありませんので、このような質問をさせていただいた次第です。

お手数をおかけしましたが、何とか解決できそうです。
ありがとうございました。

回答No.2

fujillin

＞“○月計”と入力されるものの、E列、F列、G列へ数式は入力
＞されません。
“○月計”の入力はマクロで組まれたのですよね？
その後に、既に出来ているマクロを呼び出すように（引き続き実行するために）してあげれば、1行の追加することですみます。

ただし、もとからあるマクロは、（多分）イベント処理になっている可能性がありますので、通常のマクロに変更してあげるのが良いでしょう。
（連続して処理すれば、もとの機能は不要になるのでしょうから…）

お礼

アドバイスありがとうございます。

> “○月計”の入力はマクロで組まれたのですよね？

下記のようにコードを記述しました。
※質問文では“○月計”のみでしたが、実際はその1行下に“累計”も入力するようにしています。

---------------------------------------------------
Sub Macro1()
Dim LastR As Long
Dim shNum As Integer

　　For shNum = 4 To 39
　　　With Worksheets(shNum)
　　　　LastR = .Cells(Rows.Count, "C").End(xlUp).Row + 2
　　　　.Cells(LastR, "C").Value = "○月計"
　　　　.Cells(LastR + 1, "C").Value = "累計"
　　　End With
　　Next shNum
End Sub
---------------------------------------------------

それで、上記のコードの後に既にできているマクロ(イベントマクロです)を呼び出すようにすればよいとのことで、Call マクロ名を1行追加すればいいのですよね…。

> もとからあるマクロは、（多分）イベント処理になっている可能性がありますので、通常のマクロに変更してあげるのが良いでしょう。

もとからあるマクロを通常のマクロに変更することができないでいるのですが、元のコード(ThisWorkbook モジュールに書いている)を記載させていただきますので、アドバイスをいただけると嬉しいです。
実際はシートによって、入力する数式も違ったりしていて、質問文より複雑になっています。
文字数オーバーで、コードが記載できませんでしたので、改めて補足欄に記載させていただきます。スミマセン…。

補足

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim shName As String
shName = Sh.Name

If Len(shName) = 4 And IsNumeric(shName) Then 'シート名が４桁の数字(科目コード)だったら
If Target.Column = 3 And Target.Row >= 4 Then
If Target.Value Like "*月　計" Then
Cells(Target.Row, 5).FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R4C2:R[-1]C2)=VALUE(LEFT(RC3,LEN(RC3)-3)))*(R4C:R[-1]C))"
Cells(Target.Row, 6).FormulaR1C1 = _
"=SUMPRODUCT((MONTH(R4C2:R[-1]C2)=VALUE(LEFT(RC3,LEN(RC3)-3)))*(R4C:R[-1]C))"

Num = CLng(shName)
Select Case Num
Case Is <= 1430: Cells(Target.Row, 7).FormulaR1C1 = _
"=IF(COUNTIF(RC3,""*月　計"")<>0,SUMIF(R5C3:RC3,""*月　計"",R5C5:RC5)-SUMIF(R5C3:RC3,""*月　計"",R5C6:RC6)+R4C7,"""")"

Case 3110 To 4210: Cells(Target.Row, 7).FormulaR1C1 = _
"=IF(COUNTIF(RC3,""*月　計"")<>0,SUMIF(R5C3:RC3,""*月　計"",R5C6:RC6)-SUMIF(R5C3:RC3,""*月　計"",R5C5:RC5)+R4C7,"""")"

Case 8110 To 8180, 4211: Cells(Target.Row, 7).FormulaR1C1 = _
"=IF(COUNTIF(RC3,""*月　計"")=1,RC6-RC5,IF(RC3=""累　計"",SUMIF(R5C3:RC3,""*月　計"",R5C7:RC7),""""))"

Case Is >= 8311, 1431: Cells(Target.Row, 7).FormulaR1C1 = _
"=IF(COUNTIF(RC3,""*月　計"")=1,RC5-RC6,IF(RC3=""累　計"",SUMIF(R5C3:RC3,""*月　計"",R5C7:RC7),""""))"
End Select
ElseIf Target.Value = "累　計" Then
Cells(Target.Row, 5).FormulaR1C1 = _
"=IF(RC3=""累　計"",SUMIF(R5C3:RC3,""*月　計"",R5C:RC),"""")"
Cells(Target.Row, 6).FormulaR1C1 = _
"=IF(RC3=""累　計"",SUMIF(R5C3:RC3,""*月　計"",R5C:RC),"""")"
If CLng(shName) >= 4211 Or CLng(shName) = 1431 Then
Cells(Target.Row, 7).FormulaR1C1 = _
"=IF(RC3=""累　計"",SUMIF(R5C3:RC3,""*月　計"",R5C:RC),"""")"
End If
End If
End If
End If
End Sub

回答No.1

dr-9

どうせでしたら、“○月計”とE列、F列、G列へ数式も一緒に処理されたらどうでしょう？
ひとつのアイディアですが、ThisWorkbookには「Workbook_SheetBeforeRightClick」イベントがありますのでこれを利用してみてはどうでしょうか？

お礼

アドバイスありがとうございます。
できるだけ現状のまま使用したいのですが、うまくいかない場合は、教えていただいたアイディアで試してみたいと思います。
ありがとうございました。