Excelにて、ボタンで動作するVBAコードをご教授願います。

現在、シートモジュールに下記、コードがあります。ボタンを作り使用したく
コードを変更し使用したいのですが、何処を変更及び追加したら動作する
のかご教授願います。


Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Row < 4 Or .Column <> 5 Then Exit Sub
Application.EnableEvents = False
If Time < TimeSerial(12, 0, 0) Then
Cells(.Row, Day(Date) * 2 + 9).Value = .Value
Else
Cells(.Row, Day(Date) * 2 + 10).Value = .Value
End If
Application.EnableEvents = True
End With
End Sub

宜しくお願い致します。

質問者からの補足コメント

• ありがとうございます。
  確認しました。
  うまく動いてくれません
  処理が途中で完了しない状態です
  End Ifの所で、エラー（止まってしまうのか？）
  
  すみません

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/01/11 07:02

• すみません
  確認不足でした
  
  実際、動作はOKでした。
  凄く完了するまでに時間がかかっており止まっているものだと
  勘違いしてしまいました。
  
  ごめんなさい
  
  シートモジュールですと早いのですが、標準モジュールだと
  なぜ、こんなに処理に時間がかかるのでしょうか
  入力と同時にといかないのでしょうか（詳しくなくてすみません）
  早くする方法はありますか

  No.3の回答に寄せられた補足コメントです。 補足日時：2021/01/11 14:22

• ありがとうございます。
  ＞少しは早くなったかな？
  ⇒感じ的には、あまり変わりません
  
  ＞行数はどの位あるのでしょう？10000とかあるのでしょうか？
  ⇒2000位です

  No.4の回答に寄せられた補足コメントです。 補足日時：2021/01/11 16:12

• 本当にありがとうございました。
  ＞少しは早くなったかな？
  ⇒再度確認したら、早くなっています
  
  感謝いたします。

    補足日時：2021/01/11 18:48

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2021/01/11 15:28

＞シートモジュールですと早いのですが、標準モジュールだと

＞なぜ、こんなに処理に時間がかかるのでしょうか
多分、処理の問題です。
＃３のsampleは、E列の4行目から最終行まで実行します。行数はどの位あるのでしょう？10000とかあるのでしょうか？
E4セルを選択して　Ctrl+↓キーを押してCtrl+↑キーを押してみてください。
回答の方法は、べたにループで処理していますので
配列やレンジオブジェクトなどで一度に書き出すと早くなると思います。
やり方は色々ですが、例えばこんな感じ
Sub a()
Dim myRng As Range
Dim oColm As Long
With ActiveSheet
Application.EnableEvents = False
Set myRng = .Range("E4", .Cells(Rows.Count, "E").End(xlUp))
If Time < TimeSerial(12, 0, 0) Then
oColm = Day(Date) * 2 + 9
Else
oColm = Day(Date) * 2 + 10
End If
Application.ScreenUpdating = False
.Cells(4, oColm).Resize(.Cells(Rows.Count, "E").End(xlUp).Row - 3) = myRng.Value
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub
少しは早くなったかな？

ちなみに、ご質問のコードは1セルのみの処理なので当然処理時間は
かからないと思います。＃３のSub b()に該当

この回答へのお礼

対応ありがとうございます。
感謝いたします。

お礼日時：2021/01/11 16:26

No.3 回答者： Qchan1962 回答日時： 2021/01/11 11:45

#2です

＞処理が途中で完了しない状態です
＞End Ifの所で、エラー（止まってしまうのか？）
困りました、、、何かエラーは出ているのでしょうか？
処理シートをアクティブな状態で実行していますか？
If .Row < 4 Or .Column <> 5 Then Exit Sub とありますが、
E4セル以降（行方向）に値はありますか？

検証せず投稿したので確認しましたが、問題ないように思います

実行が午前中であれば、日付の2倍+９のカラムにE列該当行の値が出力される。今なら、AE列　31行目　　（11×2+９）

検証用にメッセージボックスを入れたプロシージャを書いておきます。

'標準モジュールに以下すべてをコピペ
'実行プロシージャは　sample
'E4以降まとめて
Sub sample()
Dim i As Long
Dim msg As String
　With ActiveSheet
　　Application.EnableEvents = False
　　For i = 4 To .Cells(Rows.Count, 5).End(xlUp).Row
　　　If Time < TimeSerial(12, 0, 0) Then
　　　　.Cells(i, Day(Date) * 2 + 9).Value = .Cells(i, 5).Value
　　　　msg = msj_Creation(msg, "午前", i, .Cells(i, 5).Value)
　　　Else
　　　　.Cells(i, Day(Date) * 2 + 10).Value = .Cells(i, 5).Value
　　　　msg = msj_Creation(msg, "午後", i, .Cells(i, 5).Value)
　　　End If
　　Next
　　Application.EnableEvents = True
　End With
　If msg <> "" Then
　　MsgBox (msg)
　Else
　　MsgBox ("E列4行目以降にデータはありません。")
　End If
End Sub

Function msj_Creation _
(msg As String, AMPM As String, i As Long, valA)
If msg = "" Then
msg = AMPM & "の処理を完了しました　処理は" & vbCrLf & _
ActiveSheet.Name & "シート" & vbCrLf & Day(Date) * 2 + 9 & _
"列" & i & "行　値＝" & valA & vbCrLf
Else
msg = msg & Day(Date) * 2 + 9 & "列" & i & "行　値＝" & valA & vbCrLf
End If
msj_Creation = msg
End Function


'標準モジュールに
'実行プロシージャは　b
'アクティブセル用
Sub b()
Dim msg As String
　With ActiveCell
　　If .Row < 4 Or .Column <> 5 Then
　　　MsgBox ("E4セル以降を選択してください")
　　Else
　　　Application.EnableEvents = False
　　　If Time < TimeSerial(12, 0, 0) Then
　　　　Cells(.Row, Day(Date) * 2 + 9).Value = .Value
　　　　If .Value <> "" Then
　　　　　msg = msj_Creation("", "午前", .Row, .Value)
　　　　Else
　　　　　msg = msj_Creation("", "午前", .Row, "空白")
　　　　End If
　　　Else
　　　　Cells(.Row, Day(Date) * 2 + 10).Value = .Value
　　　　If .Value <> "" Then
　　　　　msg = msj_Creation("", "午前", .Row, .Value)
　　　　Else
　　　　　msg = msj_Creation("", "午前", .Row, "空白")
　　　　End If
　　　End If
　　　Application.EnableEvents = True
　　　MsgBox (msg)
　　End If
　End With
End Sub

この回答へのお礼

ありがとうございます。

お礼日時：2021/01/11 16:25

No.2 回答者： Qchan1962 回答日時： 2021/01/11 02:37

こんばんは、

＞ボタンを作り使用したく
ボタンイベントか新たにプロシージャを作りボタンに登録し
With Target　>>> With ActiveCell

Changeイベントをボタンにすると言う事は、
＞If .Row < 4 Or .Column <> 5 Then Exit Sub
E列4行目からE列最終行までを纏めて処理する事がご希望ですか？

ならこんな感じでしょうか。
Dim i As Long
　With ActiveSheet
　　Application.EnableEvents = False
　　For i = 4 To .Cells(Rows.Count, 5).End(xlUp).Row
　　　If Time < TimeSerial(12, 0, 0) Then
　　　　.Cells(i, Day(Date) * 2 + 9).Value = .Cells(i, 5).Value
　　　Else
　　　　.Cells(i, Day(Date) * 2 + 10).Value = .Cells(i, 5).Value
　　　End If
　　Next
　　Application.EnableEvents = True
　End With

Worksheetイベントもしくはシートに設置したボタンのみからの実行で、実行（設置）されているシートを処理する場合ActiveSheetを省略しても構いません。念のためシートオブジェクトをActiveSheetとしていますが、明示した方が良いと思います。

この回答へのお礼

ありがとうございます。

お礼日時：2021/01/11 16:24

No.1 回答者： ずんだしらたま 回答日時： 2021/01/10 15:12

セルの値が変化した時に走る処理ですよね。

引数のtargetが、その変化したセルです。

まず、ボタン名_Click(関数を)追加します。
ボタンコントロールをシートに張り付けて、編集モードでダブルクリックすれば自動で作成されます。
これがボタンをクリックした時に走る処理になります。

基本的には質問文にあるソースをそのまま移植すれば良いのですが、それだけだと、どこのセルを対象にするのかが指定されていません。
targetの部分を操作したいセルに変更してください。

例えば、with range("A1") の様な感じです。

この回答へのお礼

ありがとうございます。
参考にさせて頂きます

お礼日時：2021/01/11 16:24