[[20230508172021]]　『Private Sub Worksheet_Change(ByVal Target As R』（トト）　ページの最後に飛ぶ

『Private Sub Worksheet_Change(ByVal Target As Range)に関して』（トト）

Private Sub Worksheet_Change(ByVal Target As Range)を同シートで複数動作させたいです。

ですが、マクロ呼び出しなどでは定義した内容が反映されず、エラーになってしまいます。宣言ﾘｾｯﾄのコードも使用してみましたが、エラーになります。
以下二つを組み合わせることは、出来ないでしょうか？

大雑把な質問で伝わらなかったら申し訳ございません。

～1つ目～

Private Sub Worksheet_Change(ByVal Target As Range)

　' 「依頼」シートのG列の4行目以降に値が入力された場合に実行
　If Target.Column = 7 And Target.row >= 4 Then
　If Target.Cells.CountLarge > 1 Then ' 変更されたセルが複数の場合にエラーメッセージを表示
　MsgBox "複数セル変更は動作しません" & vbCrLf & "1行ずつ入力or削除してください。"
　ElseIf IsEmpty(Target.Value) Then ' 変更されたセルの値が空の場合にのみマクロを実行
　Application.EnableEvents = False ' イベントの無効化
　Range("K" & Target.row & ":O" & Target.row).ClearContents ' セルの中身の削除
　Application.EnableEvents = True ' イベントの有効化

Else ' 変更されたセルの値が空でない場合にマクロを実行

　Dim searchValue As String
　Dim searchRange As Range
　Dim foundCell As Range
　Dim rowNum As Integer

  searchValue = Target.Value '検索値として、変更されたセルの値を使用  
  Set objIE = Nothing

'---------以下動作コード-----------

EndSub
'----------------------------------

～2つ目～
Private Sub Worksheet_Change(ByVal Target As Range)

   ' 変数宣言
   Dim ws1 As Worksheet, ws2 As Worksheet
   Dim searchRange As Range, cell As Range, foundRange As Range
   Dim searchString As String
   Dim copyRange As Range
   Dim i As Long, lastRow As Long
   Dim pasteRange As Range

'---------以下動作コード-----------

EndSub
'----------------------------------

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

同じシートモジュールに２つWorksheet_Changeプロシージャがあるなら、そりゃエラーになるでしょう。
（　･ふ･） 2023/05/08(月) 17:42:21

Worksheet_Changeはもちろんのこと、同じモジュールに同じ名前のプロシージャが複数あるとエラーになります。
同じタイミングで発動するプロシージャなので１つに統合して、それぞれ矛盾の無いように記述してください。
（火災報知器） 2023/05/08(月) 18:15:32

お二方ありがとうございます。

上記記載コードは同じプロシャージャーではなく個別に作成しました。
それをマクロ呼び出しやcaseコードなどでどうにか出来ないか試していました。

個別のコードは相当長いので、１つにまとめずに出来る方法が無いか模索しております。
もし何かあればアドバイス頂ければ幸いです。

（トト） 2023/05/08(月) 18:29:40

この話はよくある質問ですので、過去ログをあたれば答えがあります。

ざっくり書くと

 Private Sub Worksheet_Change(ByVal Target As Range)
    ～～１つめの実行条件～～～
        ↑を満たすときの処理

    ～～２つめの実行条件～～～
        ↑を満たすときの処理
 End Sub

みたいにすればよいです。

なお、Changeイベントは「Targe」が（飛び飛びの）複数セルになることがあり得ます。
したがって↓のような判定ではなく、Intersectメソッドを使って判定することをおすすめします。

 If Target.Column = 7 And Target.row >= 4 Then

（もこな２） 2023/05/08(月) 20:20:53

追加で。
提示されたコードを整理してみると、おそらく↓のような感じになると思います。

   Private Sub Worksheet_Change(ByVal Target As Range)
      Dim tmpRNG As Range

      Dim searchValue As String
      Dim searchRange As Range
      Dim foundCell As Range
      Dim rowNum As Integer
      Dim objIE As Object '★追加

      Dim ws1 As Worksheet, ws2 As Worksheet
      Dim cell As Range, foundRange As Range
      Dim searchString As String
      Dim copyRange As Range
      Dim i As Long, lastRow As Long
      Dim pasteRange As Range

      '１つめの実行条件
      If Not Intersect(Target, Range("G4:G" & Rows.Count)) Is Nothing Then 'G列の4行目以降
         If Target.Cells.CountLarge > 1 Then
            MsgBox "複数セル変更は動作しません" & vbCrLf & "1行ずつ入力or削除してください。"
         Else
            If IsEmpty(Target.Value) Then 'Targetの値が空の場合
               Application.EnableEvents = False ' イベントの無効化
               Intersect(Target.EntireRow, Range("K:O")).ClearContents ' セルの中身の削除
               Application.EnableEvents = True ' イベントの有効化
            Else 'Targetの値が空でない場合
               searchValue = Target.Value '検索値として、変更されたセルの値を使用
               Set objIE = Nothing
               '---------以下【１つめの】動作コード-----------
            End If '★追加
         End If '★追加
      End If

      '２つめの実行条件

            '---------以下【２つめの】動作コード-----------

   End Sub

こだわりが無ければインデントをつけてコードを見やすく整理しておくと、デバッグ作業の効率アップに寄与すると思います

（もこな２） 2023/05/08(月) 21:33:02

もこな２さま

ご返信ありがとうございました。
頂いたアドバイスをもとにチャレンジしてみたいと思います。

本当にありがとうございました。
（トト） 2023/05/08(月) 21:55:58

もこな２さま

本日、アドバイス頂いた内容で修正を行ったところ、希望の動作が出来ました！
とても勉強になりました！

本当にありがとうございました。
（トト） 2023/05/09(火) 18:24:57

コメント返信：

[ 一覧(最新更新順) ]

[[20230508172021]] 『Private Sub Worksheet_Change(ByVal Target As R』（トト） ページの最後に飛ぶ

[[20230508172021]]　『Private Sub Worksheet_Change(ByVal Target As R』（トト）　ページの最後に飛ぶ