『Worksheet_Changeを２つ以上登録する場合について』（マクロ初心者）
[挨拶文]
はじめまして。
務めている会社よりエクセルで工数管理を省略化したいと言われ何とかマクロを組めないかと、試行錯誤を繰り返しております。
初めてのマクロで基礎も分かっておらず、数日間悩んでおります。
マクロもWEBから参考し数値変更したものばかりです。
Sheet1にシート非表示のマクロと、日付自動入力のマクロを入力したいのですが、Worksheet_Changeを２つ以上登録する方法がわかりません。
どなたかご教授頂けますと助かります。
シート非表示のマクロ
Const ROW_MIN = 5
Const ROW_MAX = 25
Const COL_INPUT = 15
Const COL_SHEETNAME = 16
Const VALUE_VISIBLE = "〇"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim configRange As Range Set configRange = Range(Cells(ROW_MIN, COL_INPUT), Cells(ROW_MAX, COL_SHEETNAME)) If Intersect(Target, configRange) Is Nothing Then Exit Sub
Dim Row As Long
Dim targetSheet As Worksheet
For Row = ROW_MIN To ROW_MAX
Set targetSheet = ThisWorkbook.Worksheets(Cells(Row, COL_SHEETNAME).Value)
If Cells(Row, COL_INPUT) = VALUE_VISIBLE Then
targetSheet.Visible = xlSheetVisible
Else
targetSheet.Visible = xlSheetHidden
End If
Next
End Sub
日付自動入力のマクロ
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
For Each r In Target
If r.Column = 3 Then
r.Offset(0, -2).Value = Format(Now, "mm/dd")
End If
Next r
End Sub
＜ 使用 Excel：unknown、使用 OS：Windows11 ＞
ひとつのプロシージャにまとめればよいでしょう。 ・日付自動入力のマクロ を先に実行し ・シート非表示のマクロ を次に実行 すればよいでしょう。
逆の順序で実行すると、 If Intersect(Target, configRange) Is Nothing Then Exit Sub で終了してしまうので。
なお、日付自動入力のマクロ のなかでは、
Application.EnableEvents = False
r.Offset(0, -2).Value = Format(Now, "mm/dd")
Application.EnableEvents = True
とすべきです。
r.Offset(0, -2).Value = Format(Now, "mm/dd")の実行によって、
自分自身（イベントプロシージャ）が再実行されるのを防ぐためです。
# コードの詳細は見ていません。
（xyz） 2025/05/27(火) 18:20:07
コピペしたら使えるようなものをご提示いただけると助かります。
よろしくお願いいたします。
（マクロ初心者） 2025/05/28(水) 11:14:43
Private Sub Worksheet_Change(ByVal Target As Range)
' --- 日付自動入力 ---
Dim r As Range
For Each r In Target
If r.Column = 3 Then
r.Offset(0, -2).Value = Format(Now, "mm/dd")
End If
Next r
' --- シート非表示/表示 ---
Const ROW_MIN = 5
Const ROW_MAX = 25
Const COL_INPUT = 15
Const COL_SHEETNAME = 16
Const VALUE_VISIBLE = "〇"
Dim configRange As Range
Set configRange = Range(Cells(ROW_MIN, COL_INPUT), Cells(ROW_MAX, COL_SHEETNAME))
If Not Intersect(Target, configRange) Is Nothing Then
Dim Row As Long
Dim targetSheet As Worksheet
For Row = ROW_MIN To ROW_MAX
On Error Resume Next ' シート名が不正な場合にも対応
Set targetSheet = ThisWorkbook.Worksheets(Cells(Row, COL_SHEETNAME).Value)
If Not targetSheet Is Nothing Then
If Cells(Row, COL_INPUT).Value = VALUE_VISIBLE Then
targetSheet.Visible = xlSheetVisible
Else
targetSheet.Visible = xlSheetHidden
End If
End If
Set targetSheet = Nothing
On Error GoTo 0
Next Row
End If
End Sub
（暇な人） 2025/05/28(水) 12:29:44
■１
＞Worksheet_Changeを２つ以上登録
過去ログを見てもらうとなんとなくわかるかと思いますが、そもそも１つのシートモジュールに「Changeイベント」を複数配置できません。
提示したコードの内容をどこまで理解で来ているかわかりませんが、考え方を【条件に一致したら（しなかったら）処理を終了する】という考え方から【条件に一致する（しない）時だけ処理する】という考え方にするとよいとおもいます。
■２
定数をいくつか使用されていますが、この程度であれば定数を使わない方がかえって見やすいんじゃないかと思います。
■３
＞コピペしたら使えるようなものをご提示いただけると助かります。
私見になりますが、丸投げしたいのであれば対価を払って作成依頼するようなサイトに移動するのも手だとおもいます。
以下「■１」「■２」を踏まえて、私なりに整理したものを提示します。
完成品プレゼントの意図はありませんので、理解せずにそのままコピペするだけであれば使用しないでください。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyROW As Long, MyRNG As Range
'▼一つ目
If Not Intersect(Target, Range("O5:P25")) Is Nothing Then '★ここで処理するか判定
For MyROW = 5 To 25 Step 1
If Cells(MyROW, "O").Value = "〇" Then
ThisWorkbook.Worksheets(Cells(MyROW, "P").Value).Visible = xlSheetVisible
Else
ThisWorkbook.Worksheets(Cells(MyROW, "P").Value).Visible = xlSheetHidden
End If
Next
End If
'▼二つ目
Set MyRNG = Intersect(Target, Range("C:C"))
If Not MyRNG Is Nothing Then '★ここで処理するか判定
Intersect(MyRNG.EntireRow, Range("A:A")).Value = Format(Now, "mm/dd")
End If
End Sub
■４
上記の一つ目について、今のままだと逐一5〜25行目まで処理することになっています。
本来は、O列なりP列が書き変わった行だけ処理すればよかったりしませんか？
（もこな２ ） 2025/05/28(水) 14:22:17
ん？ マクロを１つにまとめる？ ↓こういうこと？
Const ROW_MIN = 5 Const ROW_MAX = 25 Const COL_INPUT = 15 Const COL_SHEETNAME = 16 Const VALUE_VISIBLE = "〇"
Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Change_1 Target '１つ目のイベント処理
Worksheet_Change_2 Target '２つ目のイベント処理
End Sub
Sub Worksheet_Change_1(ByVal Target As Range)
Dim configRange As Range
Set configRange = Range(Cells(ROW_MIN, COL_INPUT), Cells(ROW_MAX, COL_SHEETNAME))
If Intersect(Target, configRange) Is Nothing Then Exit Sub
Dim Row As Long
Dim targetSheet As Worksheet
For Row = ROW_MIN To ROW_MAX
Set targetSheet = ThisWorkbook.Worksheets(Cells(Row, COL_SHEETNAME).Value)
If Cells(Row, COL_INPUT) = VALUE_VISIBLE Then
targetSheet.Visible = xlSheetVisible
Else
targetSheet.Visible = xlSheetHidden
End If
Next
End Sub
Sub Worksheet_Change_2(ByVal Target As Range)
Dim r As Range
For Each r In Target
If r.Column = 3 Then
r.Offset(0, -2).Value = Format(Now, "mm/dd")
End If
Next r
End Sub
ちなみに、 Const VALUE_VISIBLE = "〇" ← 記号の丸ではなく、漢数字の零で良いの？ （ん？） 2025/05/28(水) 21:52:13
仕様から考えれば、前者は書き換えがあった行だけ見ればよいはずなのと、P列に存在しないシート名を書かれちゃうとエラー停止してしまうので、そこの対策が必要であるように思います。
また、ChangeイベントはTargetが複数セルになることがあり得ます。
この特性と処理内容を踏まえると、
前者・・・・1行ずつみていく必要あり
後者・・・・該当行（セル）を一括処理すればＯＫ
というような整理が可能です。
ということで研究用材料として整理したコードを置いておきます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tmpRNG As Range, MyRNG As Range
Stop 'ブレークポイントの代わり
'▼一つ目（シート非表示のマクロ）
Set MyRNG = Intersect(Target, Range("O5:P25"))
If Not MyRNG Is Nothing Then
On Error Resume Next
For Each tmpRNG In Intersect(MyRNG.EntireRow, Range("O:O"))
ThisWorkbook.Worksheets(tmpRNG.Offset(, 1).Value).Visible = tmpRNG.Value = "〇"
Next tmpRNG
On Error GoTo 0
End If
'▼二つ目（日付自動入力のマクロ）
Set MyRNG = Intersect(Target, Range("C:C"))
If Not MyRNG Is Nothing Then
Intersect(MyRNG.EntireRow, Range("A:A")).Value = Format(Now, "mm/dd")
End If
End Sub
（もこな２） 2025/05/31(土) 09:39:33
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.