[[20230923150449]]　『Private Sub Worksheet_Changeを2つ繋げたい』（湯豆腐）　ページの最後に飛ぶ

『Private Sub Worksheet_Changeを2つ繋げたい』（湯豆腐）

毎度お世話になります。
Private Sub Worksheet_Changeのコードを2つ繋げたいのですがうまくいかず、
後のコードのマクロが実行されません。
EndIfの後にそのままDim～と繋げたり、
Select Case Target.Address
Case "A5:A7"
If～
EndIf
Case "F5:K47,M5:O47"
dim～
EndWith
で分けたりしてみたのですがどうにもうまくいかず…

単体ではどちらも正常に機能します。

Private Sub Worksheet_Change(ByVal Target As Range)

 '年月に対して日付を曜日に合わせて移動
    If Intersect(Target, Range("A1:E1")) Is Nothing Then
        Exit Sub
    Else
        Range("A5").Copy
        Range("A6:A47").PasteSpecial Paste:=xlPasteFormulas ' 日付5行をコピーして6～47行へペースト
        Application.CutCopyMode = False

        Cells(Weekday(DateSerial(Range("A1"), Range("E1"), 1)) + 5, 1) = 1 '年月から1日の曜日のシリアル値を取得して5行（タイトル行）足したセルに1と入力する
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) '1234と入力すると12：34と変換

    Dim t As String
On Error Resume Next
t = Target.Value
If Application.Intersect(Target, Range("F5:K47,M5:O47")) Is Nothing Then Exit Sub
If Len(t) = 3 Then t = "0" & t
If Len(t) = 2 Then t = "00" & t
If Len(t) = 1 Then t = "000" & t
With Target
If Len(t) <> 4 Then Exit Sub
.NumberFormatLocal = "h:mm;@"
Application.EnableEvents = False
 .Value = Left(t, 2) & ":" & Right(t, 2)
 Application.EnableEvents = True
End With
End Sub

どうかよろしくお願いいたします。

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

 ＞単体ではどちらも正常に機能します。

 失礼ながら、ちょっと不安になります。・・けど、お言葉を信じることにします。
 ただ、最低でも無駄なイベント発生の連鎖は抑止してください。

 さて、「2つ繋げたい」とのことなので、
 直ぐExitしないで、そこでもう一方のプログラムをCallすれば良さそうに思います。
 　　　　　　　　　　↓
 ＞If Intersect(Target, Range("A1:E1")) Is Nothing Then
 ＞     Exit Sub

 勿論、同名のプログラムは共存できないので、もう一方のプログラムは
 「Private Sub Worksheet_TimeChange」とでも変更する。

 具体的には一番目のプログラムは以下となる。

 Private Sub Worksheet_Change(ByVal Target As Range)
  '年月に対して日付を曜日に合わせて移動
     If Intersect(Target, Range("A1:E1")) Is Nothing Then
         Call Worksheet_TimeChange(Target)
         Exit Sub
     Else
         Range("A5").Copy

         Application.EnableEvents = False ’←無駄なイベント発生の抑止

         Range("A6:A47").PasteSpecial Paste:=xlPasteFormulas ' 日付5行をコピーして6～47行へペースト
         Application.CutCopyMode = False

         '年月から1日の曜日のシリアル値を取得して5行（タイトル行）足したセルに1と入力する
         Cells(Weekday(DateSerial(Range("A1"), Range("E1"), 1)) + 5, 1) = 1

         Application.EnableEvents = True
     End If
 End Sub

 'プログラムの名前だけ変更する
 Private Sub Worksheet_TimeChange(ByVal Target As Range) '1234と入力すると12：34と変換
 　　　　'以下は従来と同じ
 End Sub

 ※実地テストはしておりません。あしからず。

（半平太） 2023/09/23(土) 16:31:50

半平太様

無事に動きました！
有難うございます！
（湯豆腐） 2023/09/23(土) 17:12:46

コメント返信：

[ 一覧(最新更新順) ]

[[20230923150449]] 『Private Sub Worksheet_Changeを2つ繋げたい』（湯豆腐） ページの最後に飛ぶ

[[20230923150449]]　『Private Sub Worksheet_Changeを2つ繋げたい』（湯豆腐）　ページの最後に飛ぶ