【先着1,000名様!】1,000円分をプレゼント!

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


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

A 回答 (4件)

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


>なぜ、こんなに処理に時間がかかるのでしょうか
多分、処理の問題です。
#3の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セルのみの処理なので当然処理時間は
かからないと思います。#3のSub b()に該当
この回答への補足あり
    • good
    • 0
この回答へのお礼

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

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

#2です


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

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

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

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

'標準モジュールに以下すべてをコピペ
'実行プロシージャは 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
この回答への補足あり
    • good
    • 0
この回答へのお礼

ありがとうございます。

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

こんばんは、


>ボタンを作り使用したく
ボタンイベントか新たにプロシージャを作りボタンに登録し
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としていますが、明示した方が良いと思います。
この回答への補足あり
    • good
    • 0
この回答へのお礼

ありがとうございます。

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

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


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

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

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

例えば、with range("A1") の様な感じです。
    • good
    • 0
この回答へのお礼

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング