Question

我希望能够在四分之一小时内完成时间，所以当它超过四分之一小时的时间时，它会向上舍入，当它在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

以下是我对答案的看法：

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

Answer 2

尝试以下方法：

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 3

这是我的尝试。该函数有两个参数。要舍入的日期和可选的roundingThreshold是一个字节。您可以通过更改此roundingThreshold值来设置新的舍入点。目前它设置为3，这意味着，大于3的值将舍入到下一个最接近的15分钟间隔。

它应该很快运行，我运行了6000个日期的测试，花了不到一秒钟。

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

按季度访问VBA轮

3 个答案: