時間の四分の一までのVBAラウンドへのアクセス

Question

時間の四分の一を四捨五入することができるようにするため、四半期の3分後に丸めて、3分以内に丸めます。以下のように：

08:01 (will be 08:00) 
08:03 (will be 08:00) 
08:04 (will be 08:15) 

Excelで動作するように管理されていますが、Accessで動作させることはできません。ここで

は、Excelの数式です：

=(TRUNC((VALUE("08:03")+VALUE("00:11"))*96)*VALUE("00:15")) 

Answer 1

は、以下のことを試してみてください。

Option Compare Database 
Option Explicit 

Sub Test_time() 
Dim i As Integer 
Dim dTime As Date 
    dTime = #8:00:00 AM# 
    For i = 0 To 75 
     dTime = DateAdd("n", 1, dTime) 
     Debug.Print dTime & vbTab & Format(Trunc(dTime), "hh:mm") 
    Next i 
End Sub 

Function Trunc(vTime As Date) As Date 
Dim iHr, iMin As Integer 
Dim iQtr As Integer 
Dim MyTime As Date 
    iHr = Hour(vTime) 
    iMin = Minute(vTime) 
    iQtr = Int(iMin/15) 
    If iMin - (iQtr * 15) < 4 Then 
     MyTime = DateAdd("h", iHr, 0) 
     MyTime = DateAdd("n", iQtr * 15, MyTime) 
    Else 
     MyTime = DateAdd("h", iHr, 0) 
     MyTime = DateAdd("n", (iQtr + 1) * 15, MyTime) 
    End If 
    Trunc = MyTime 
End Function 

Answer 2

ここに私の試みです。この関数は2つの引数をとります。四捨五入する日付とオプションのroundingThreshold（バイト）です。このroundingThresholdの値を変更すると、新しい丸めポイントを設定できます。現在は3と設定されています。つまり、3より大きい値は、次に近い15分間隔に丸められます。

実行するのはかなり速いはずです。私は6000の日付のようなテストを行い、1秒未満で完了しました。

Option Explicit 

Public Function roundDate(dateIn As Date, _ 
          Optional roundThreshold As Byte = 3) As Date 

    'get the minutes from the date 
    Dim minutes As Byte: minutes = Format(dateIn, "nn") 
    Dim revisedMin As Byte 

    'Determine if the item should be rounded up/down 
    If minutes Mod 15 > roundThreshold Then 
     'Round up to closest 15 minutes 
     'Use integer to round the number down, add 1, then multiply by 15 
     revisedMin = minutes + ((((minutes \ 15) + 1) * 15) - minutes) 
    Else 
     'Round down to the closest 15 min interval 
     revisedMin = minutes - minutes Mod 15 
    End If 

    'Rebuild the date with the rounded date 
    If Not revisedMin = 60 Then 
     roundDate = CDate(Format(dateIn, "hh") & ":" & revisedMin) 
    Else 
     roundDate = CDate(DateAdd("h", 1, Format(dateIn, "hh") & ":00")) 
    End If 

End Function 

---

試験結果：

Test Date  Rounded Result 
9:00:00 AM 9:00:00 AM 
9:01:00 AM 9:00:00 AM 
9:02:00 AM 9:00:00 AM 
9:03:00 AM 9:00:00 AM 
9:04:00 AM 9:15:00 AM 
9:05:00 AM 9:15:00 AM 
9:06:00 AM 9:15:00 AM 
9:07:00 AM 9:15:00 AM 
9:08:00 AM 9:15:00 AM 
9:09:00 AM 9:15:00 AM 
9:10:00 AM 9:15:00 AM 
9:11:00 AM 9:15:00 AM 
9:12:00 AM 9:15:00 AM 
9:13:00 AM 9:15:00 AM 
9:14:00 AM 9:15:00 AM 
9:15:00 AM 9:15:00 AM 
9:16:00 AM 9:15:00 AM 
9:17:00 AM 9:15:00 AM 
9:18:00 AM 9:15:00 AM 
9:19:00 AM 9:30:00 AM 
9:20:00 AM 9:30:00 AM 
9:21:00 AM 9:30:00 AM 
9:22:00 AM 9:30:00 AM 
9:23:00 AM 9:30:00 AM 
9:24:00 AM 9:30:00 AM 
9:25:00 AM 9:30:00 AM 
9:26:00 AM 9:30:00 AM 
9:27:00 AM 9:30:00 AM 
9:28:00 AM 9:30:00 AM 
9:29:00 AM 9:30:00 AM 
9:30:00 AM 9:30:00 AM 
9:31:00 AM 9:30:00 AM 
9:32:00 AM 9:30:00 AM 
9:33:00 AM 9:30:00 AM 
9:34:00 AM 9:45:00 AM 
9:35:00 AM 9:45:00 AM 
9:36:00 AM 9:45:00 AM 
9:37:00 AM 9:45:00 AM 
9:38:00 AM 9:45:00 AM 
9:39:00 AM 9:45:00 AM 
9:40:00 AM 9:45:00 AM 
9:41:00 AM 9:45:00 AM 
9:42:00 AM 9:45:00 AM 
9:43:00 AM 9:45:00 AM 
9:44:00 AM 9:45:00 AM 
9:45:00 AM 9:45:00 AM 
9:46:00 AM 9:45:00 AM 
9:47:00 AM 9:45:00 AM 
9:48:00 AM 9:45:00 AM 
9:49:00 AM 10:00:00 AM 
9:50:00 AM 10:00:00 AM 
9:51:00 AM 10:00:00 AM 
9:52:00 AM 10:00:00 AM 
9:53:00 AM 10:00:00 AM 
9:54:00 AM 10:00:00 AM 
9:55:00 AM 10:00:00 AM 
9:56:00 AM 10:00:00 AM 
9:57:00 AM 10:00:00 AM 
9:58:00 AM 10:00:00 AM 
9:59:00 AM 10:00:00 AM 
10:00:00 AM 10:00:00 AM 

Answer 3

ここに答えが私の感想です：いくつかのより多くの例をリストアップ、

Public Function RoundTime(d As Date) As Date 
    'Round 08:03:59 down, round 8:04:00 up 
    RoundTime = Int(d * 96 + 11/15)/96 
    'or 
    'Round 08:03:00 down, round 8:03:01 up 
    'RoundTime = Int(d * 96 + 12/15)/96 
End Function