[[20180621112545]]　『日付毎に時間の最初と最後を色づけ』（ちはる）　ページの最後に飛ぶ

『日付毎に時間の最初と最後を色づけ』（ちはる）

初めまして。

オフィスの入退室記録の管理を行う予定です。
入退室記録がＣＳＶファイルで出力され、ピポットテーブルを活用し名前毎の時間表を下記のように作成しました。
ここで、日付毎の最初と最後の時間のセルに色をつけていきたいと思っています。
今までは手動だったのですが、スタッフの数が増えてきたのもあり自動的にできるようにしたいです。

例：

●●様
2018/5/6 8:22
2018/5/6 18:48
2018/5/7 8:40
2018/5/7 23:03
2018/5/8 8:41
2018/5/8 21:37
2018/5/9 8:37
2018/5/9 22:05
・
・
・
2018/5/14 8:45
2018/5/14 21:58
2018/5/15 8:45
2018/5/15 11:33
2018/5/15 11:41
2018/5/15 12:06
2018/5/15 13:07
2018/5/15 18:06
2018/5/15 22:43
2018/5/16 8:38

質問

2018/5/6 8:22
2018/5/6 18:48
・
・
・
2018/5/15 8:45
2018/5/15 22:43
のように日付毎の最初と最後の時間に色をつけたいです。

お力を貸していただけないでしょうか。
よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

＞のように日付毎の最初と最後の時間に色をつけたいです。
よくわかんないけど、偶数行と奇数行で塗り分けるだけですか？

（まっつわん） 2018/06/21(木) 12:27

問題を解決する上で明らかにしておいたほうがよいようなものを以下に示します。
ルールの後だしじゃんけんを避ける意味で

1．入退室記録で記録されているデータには、入室あるいは退室いずれなのかを明示的にするデータはないのでしょうか
2．入室時刻と退室時刻とが日を跨いでしまう可能性はないのですか。
（りょぽりょぽ） 2018/06/21(木) 12:35

＞＞のように日付毎の最初と最後の時間に色をつけたいです。
＞よくわかんないけど、偶数行と奇数行で塗り分けるだけですか？
わかりにくくてすいません。
15日のように何度も入退出を繰り返している日があるとき、
この際出勤時間が2018/5/15 8:45 、退勤時間が2018/5/15 22:43とわかるように
その日の最初と最後の時間のセルに色をつけてわかりやすくしたいと思っています。
上記の例ですと、それ以外は1日に2回しか入退室記録がないので、
その2回ともに色がつくと思われます。

＞1．入退室記録で記録されているデータには、入室あるいは退室いずれなのかを明示的にするデータはないのでしょうか
時間データと同時に入退室の記録も出てきますが、人によっては出入りが激しいため、単純に何時から何時まで出勤していたかがわかるようにしたいです。
＞2．入室時刻と退室時刻とが日を跨いでしまう可能性はないのですか。
ありますが、午前2～6時までは出入りできないようになっています。
（ちはる） 2018/06/21(木) 13:46

2018/5/15の最後を探すのは
データを降順に並び替えて、
Match関数で2018/5/15で探したら見つかると思うけど、
日付をまたいたときも同じ日と判定するのかな？＾＾；

（まっつわん） 2018/06/21(木) 14:38

Sub main()

    'Ａ列に日付、Ｂ列に時刻、シートがアクティブな状態で実行
    '最初が黄色、最後が赤
    Dim 最初 As Object, 最後 As Object, c As Range
    Cells.Interior.Pattern = xlNone
    Set 最初 = CreateObject("Scripting.Dictionary")
    Set 最後 = CreateObject("Scripting.Dictionary")
    For Each c In Range("A:A").SpecialCells(2)
        If IsDate(c.Value) Then
            If IsEmpty(最初(c.Value)) Or 最初(c.Value) >= c.Offset(, 1).Value Then 最初(c.Value) = c.Offset(, 1).Value
            If 最後(c.Value) <= c.Offset(, 1).Value Then 最後(c.Value) = c.Offset(, 1).Value
        End If
    Next c
    For Each c In Range("A:A").SpecialCells(2)
        If IsDate(c.Value) Then
            If 最初(c.Value) = c.Offset(, 1).Value Then c.Resize(, 2).Interior.Color = vbYellow
            If 最後(c.Value) = c.Offset(, 1).Value Then c.Resize(, 2).Interior.Color = vbRed
        End If
    Next c
End Sub
（mm） 2018/06/21(木) 17:55

コメント返信：

[ 一覧(最新更新順) ]

[[20180621112545]] 『日付毎に時間の最初と最後を色づけ』（ちはる） ページの最後に飛ぶ

[[20180621112545]]　『日付毎に時間の最初と最後を色づけ』（ちはる）　ページの最後に飛ぶ