スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

深夜時間の計算 


次のような質問を見かけました。

出勤から退勤までの間に深夜時間が何時間あるのかを出したい。

出勤フィールドに 2013/9/15 4:00
退勤フィールドに 2013/9/16 4:00

深夜時間帯は 22:00~翌5:00 とし、深夜時間フィールドに "7:00" と表示したい・・・

で、以下の様に考えてみました。

Public Function CalcNightTimes(ByVal dtS As Date, ByVal dtE As Date) As Date
の関数を用意して、dtS には出勤時刻、dtE には退勤時刻(双方とも、日付/時刻型)を引数に

22:00 ~ 翌 5:00 ・・・・
これ、考えにくいので、与えられた dtS / dtE 共に 2:00 時間加算しておく事に・・・
これにより、深夜時間帯は 0:00 ~ 7:00 に偏らせる事が出来ます。
この偏らせる・・・・ よく年度の「年」を求める時に Year(DateAdd("m", -3, 日付)) とかしますね。
それと同じような考え方です。

その細工をしておいて、
dtS / dtE が同じ日なら、
・ 0:00 ~ 7:00 に dtE が入っていたら、dtE - dtS が深夜時間
・ 0:00 ~ 7:00 に dtS が入っていたら、7:00 - dtS(時刻部分)が深夜時間
dtS / dtE が同じ日でなかったら、
・ 0:00 ~ 7:00 に dtS が入っていたら、7:00 - dtS(時刻部分)が朝方の深夜時間
・ dtE - Int(dtE) ・・・ 0:00 からの差を覚えておいて、それが、7:00 以上なら 7:00 に訂正
・ 上記、朝方と日付が変わった分を加算したものが深夜時間

これをコードにしてみると
Public Function CalcNightTimes(ByVal dtS As Date, ByVal dtE As Date) As Date
  Dim wdt As Date
  Dim dtR As Date

  dtS = dtS + #2:00:00 AM#
  dtE = dtE + #2:00:00 AM#
  wdt = Int(dtS) + #7:00:00 AM#
  If (Int(dtS) = Int(dtE)) Then
    If (dtE <= wdt) Then
      dtR = dtE - dtS
    ElseIf (dtS <= wdt) Then
      dtR = wdt - dtS
    End If
  Else
    If (dtS <= wdt) Then
      dtR = wdt - dtS
    End If
    wdt = dtE - Int(dtE)
    If (wdt > #7:00:00 AM#) Then wdt = #7:00:00 AM#
    dtR = dtR + wdt
  End If
  CalcNightTimes = dtR
End Function

 
以下で動作確認してみると
Public Sub test()
  Debug.Print CalcNightTimes(#9/15/2013 4:00:00 AM#, #9/16/2013 4:00:00 AM#)
  Debug.Print CalcNightTimes(#9/15/2013 8:00:00 AM#, #9/15/2013 6:00:00 PM#)
  Debug.Print CalcNightTimes(#9/15/2013 10:30:00 PM#, #9/15/2013 11:30:00 PM#)
  Debug.Print CalcNightTimes(#9/15/2013 8:00:00 AM#, #9/16/2013#)
  Debug.Print CalcNightTimes(#9/15/2013 11:00:00 PM#, #9/16/2013 4:00:00 AM#)
  Debug.Print CalcNightTimes(#9/15/2013 4:00:00 AM#, #9/16/2013 3:00:00 AM#)
  Debug.Print CalcNightTimes(#9/15/2013 3:00:00 AM#, #9/16/2013 8:00:00 PM#)
End Sub

7:00:00
0:00:00
1:00:00
2:00:00
5:00:00
6:00:00
9:00:00

の表示になります。
Date で返すので、7:00 の表示には Format / 書式 を使う・・・ 細工が必要になります。

※ 一見、上記で大丈夫そうに見えたりしますが、
    wdt = dtE - Int(dtE)
部分でおかしくなっていく事があります。その条件は、
dtS / dtE が同じ日でなかったら・・・・ の場合で、日付差が 1 を超えた場合・・・
つまり、上記のコードでは、日付差 = 1 を前提としてしています。
    dtR = dtR + wdt
この部分を ↓
    dtR = dtR + wdt
    dtR = dtR + (Int(dtE) - Int(dtS) - 1) * #7:00:00 AM#
とでも変更すれば良さそうです。
ただ、40 時間以上の連続勤務・・・・ どうなんですかね(必要なら修正するってことで)
これ、修正すると何十時間の連続勤務も計算できるようになると思いますが、また難点が・・・
深夜時間が 24 時間を超えると、年部分の表示が 1899/12/31 になってしまいます。
24 時間を超えた時の表示も、考慮する必要があります。

上記では、VBA での計算だけでやってみましたが・・・
せっかくなので、テーブル / クエリ など、使ってみようかと・・・
似た雰囲気のものは、過去記事「空き時間を求める」とかありましたけど・・・
 
過去記事「空き時間を求める」を読んで頂けるとわかると思いますが、
タイムスライスするレコードを作っておいて、それを見つけたい時間帯と照合する・・・
重複した部分が、深夜時間帯・・・・

まず、前提条件があります。
タイムスライスする「分」・・・・ これを 5 分と決めました。
これにより、「出勤」「退勤」の時刻は、5 分単位となります。

テーブル「T時刻」、フィールド「時刻」(日付/時刻型:主キー)のみ
データとしては 0:00 , 0:05 , 0:10 , ・・・・
の様に 5 分間隔でデータを入れておきます。
以下を実行しても可
Public Sub MkTimes()
  Dim rs As New ADODB.Recordset
  Dim i As Long, j As Long

  CurrentProject.Connection.Execute "DELETE * FROM T時刻;"

  rs.Open "T時刻", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 0 To 23
    For j = 0 To 55 Step 5
      rs.AddNew
      rs("時刻") = TimeSerial(i, j, 0)
      rs.Update
    Next
  Next
  rs.Close
End Sub

もう1つテーブルを・・・ テーブル名「T日連番」、フィールド「日差」(長整数:主キー)のみ
データは、0 ~ 必要な日数(「退勤」-「出勤」の日にち差)
確認時には 0 ~ 3 を入れておきましたけど・・・

で、このテーブル「T時刻」「T日連番」を直積させながら、「出勤」「退勤」帯のデータを生成します。
それ様に記述したのは、クエリ「Q深夜」
PARAMETERS [出勤] DateTime, [退勤] DateTime;
SELECT TimeSerial(0,5*Count(*),0) AS 深夜
FROM T時刻 AS Q1, T日連番 Q2
WHERE (Q2.日差 <= Int([退勤])-Int([出勤]))
AND (Int([出勤])+Q2.日差+Q1.時刻 >= [出勤])
AND (Int([出勤])+Q2.日差+Q1.時刻 < [退勤])
AND (Q1.時刻 < #5:00# OR Q1.時刻 >= #22:00#);

まず、[出勤], [退勤] は日付/時刻型ですよ・・・ とパラメータ宣言
「T時刻」「T日連番」を直積しますが、
・ 日差 <= Int([退勤])-Int([出勤]) を条件とし、
・ Int([出勤])+Q2.日差+Q1.時刻 >= [出勤] AND Int([出勤])+Q2.日差+Q1.時刻 < [退勤]
 とすることで「出勤」「退勤」間の 5 分間隔の時刻が求められる事に・・・
・それと、時刻 < #5:00# OR 時刻 >= #22:00# とする事で、深夜時間帯に絞込みします。
これにより、5 分間隔のものが何個・・・ そこから、TimeSerial(0,5*Count(*),0) で総分を求める・・・

クエリも出来上がったので、このクエリを利用した記述に変更
Public Function CalcNightTimes(dtS As Date, dtE As Date) As Date
  Dim rs As DAO.Recordset

  With CurrentDb.QueryDefs("Q深夜")
    .Parameters("[出勤]") = dtS
    .Parameters("[退勤]") = dtE
    Set rs = .OpenRecordset
  End With
  If (Not rs.EOF) Then CalcNightTimes = rs(0)
  rs.Close
  Set rs = Nothing
End Function

 
で、冒頭に記述した確認用の test() を実行してみると、同じ結果に・・・・

やっぱり、VBA だけで計算した結果より、テーブル/クエリを利用すると・・・ 遅くはなりますね


今回、サンプルファイルはありません
関連記事

2013/09/15

Category: サンプルかな

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。