セルに入力されたら日付が出るようにしたい

こんにちは。
Worksheet_Change(ByVal Target As Range)を使って
就寝時間と起床時間を毎日エクセルに記載し日付と時間を記載したいとおもってます。
また、起睡眠時間を自動で表示されるようにしたいと思ってます。

例えばC1に就寝時間とE1に起床時間を入れて
それぞれ隣の列に日付を自動で入力できるようにしたいです。
睡眠時間をF1にでるようにしたいです。
宜しくお願いいたします。

No.1 ベストアンサー 回答者： siffon9 回答日時： 2018/08/16 16:27

以下で如何でしょうか。

記録は下方向へ伸びていくと思いますので、C列、E列に値が入力された場合にイベント処理するようにしました。

B/D列の表示形式は「日付」、C/E/F列の表示形式は「時刻」にしてください。
もしF列の表示が24時間を超える場合はプログラムのコメント部分に従って修正してください。


Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim nw As Date
　　Dim dt1 As Date
　　Dim dt2 As Date
　　
　　' C列/E列以外の場合は何もしない
　　If Target.Column <> 3 And Target.Column <> 5 Then Exit Sub
　　
　　nw = Now()
　　'入力が数値の場合、左側のセルに「今」の年月日のシリアル値を書く
　　If IsNumeric(Target.Value) Then
　　　　Target.Offset(, -1).Value = DateSerial(Year(nw), Month(nw), Day(nw))
　　End If
　　With ActiveSheet
　　　　'入力行のC列/E列に数値の入力がある場合、差をF列に書く
　　　　If IsNumeric(.Cells(Target.row, "C")) And IsNumeric(.Cells(Target.row, "E")) Then
　　　　　　dt1 = CDate(.Cells(Target.row, "B").Value) + CDate(.Cells(Target.row, "C").Value)
　　　　　　dt2 = CDate(.Cells(Target.row, "D").Value) + CDate(.Cells(Target.row, "E").Value)

　　　　　　If dt1 > dt2 Then
　　　　　　　　MsgBox "B/C列の方が後の日時です。", vbExclamation
　　　　　　Else
　　　　　　　　'F列書き込み
　　　　　　　　.Cells(Target.row, "F").Value = dt2 - dt1

　　　　　　　　'F列の値が24時間を超える場合があるとき（表示形式を文字列にする）
　　　　　　　　'.Cells(Target.row, "F").Value = WorksheetFunction.Text(dt2 - dt1, "[h]:mm")
　　　　　　End If
　　　　End If
　　End With
End Sub

この回答へのお礼

ご回答ありがとうございます。
やりたいことができました。ありがとうございました。
記載いただいた内容からも学ぶことがたくさんあり勉強になりました。
またなにかありましたらご指導の程宜しくお願いいたします。

お礼日時：2018/08/21 13:07