DateDiff分为几个月访问/ vba

时间:2011-10-05 21:50:46

标签: ms-access vba datediff

如何创建类似于DateDiff的查询/ vba函数,将结果拆分为每月的天数(即2010年1月1日 - 2010年2月3日= 1月:31日,2月3日(无视格式))。

1 个答案:

答案 0 :(得分:1)

好的,我想我知道你想做什么。

首先,您需要一个函数来返回一个月中的天数,给定月份和年份(您需要知道年份以考虑因闰年而改变的2月份天数):

Function DaysInMonth(month As Integer, year As Integer) As Integer

    If month < 1 Or month > 12 Then
        DaysInMonth = -1
    Else
        DaysInMonth = Day(DateSerial(year, month + 1, 1) - 1)
    End If

End Function

我编写了一个函数 GetMonthDays ,它接受开始日期和结束日期,并返回一个整数数组(1到12),包含每个月的天数,在指定的开始之间和结束日期。开始日期和结束日期可以相隔任意数年,如有必要,它将累计每个月的总天数。

例如,函数调用如:

Dim months() As Integer
months = GetMonthDays(#6/13/2011#, #8/1/2011#)

会返回一个数组[0,0,0,0,0,18,31,1,0,0,0,0]

通话如:

months = GetMonthDays(#12/25/2010#, #1/15/2011#)

返回[15,0,0,0,0,0,0,0,0,0,0,7]

多年来,例如:

months = GetMonthDays(#12/25/2009#, #1/15/2011#)

它将返回[46,28,31,30,31,30,31,31,30,31,30,38]

你可以看到它累积了两个Januarys(31 + 15)和两个Decembers(31 + 7)的天数。我不是百分百肯定这是你想要的,但是如果给定的日期范围超过12个月,那对我来说是有道理的。

基本上,函数在开始日期和结束日期之间循环每个月,并累计每个日期。第一个月和最后一个月是特殊情况,需要进行一些计算,否则只是一个月的天数。

该功能如下,减去错误检查:

Function GetMonthDays(startDate As Date, endDate As Date) As Integer()

    Dim months(1 To 12) As Integer
    Dim monthStart As Integer
    Dim monthEnd As Integer
    Dim yearStart As Integer
    Dim yearEnd As Integer
    Dim monthLoop As Integer
    Dim yearLoop As Integer

    ' initialise months array to all zeros

    For monthLoop = 1 To 12
        months(monthLoop) = 0
    Next monthLoop

    monthStart = month(startDate)
    monthEnd = month(endDate)
    yearStart = year(startDate)
    yearEnd = year(endDate)

    monthLoop = monthStart
    yearLoop = yearStart

    Do Until yearLoop >= yearEnd And monthLoop > monthEnd

        If yearLoop = yearStart And monthLoop = monthStart Then
            months(monthLoop) = months(monthLoop) + (DaysInMonth(monthLoop, yearLoop) - Day(startDate) + 1)
        ElseIf yearLoop = yearEnd And monthLoop = monthEnd Then
            months(monthLoop) = months(monthLoop) + Day(endDate)
        Else
            months(monthLoop) = months(monthLoop) + DaysInMonth(monthLoop, yearLoop)
        End If

        If monthLoop < 12 Or (monthLoop = 12 And yearLoop = yearEnd) Then
            monthLoop = monthLoop + 1
        Else
            monthLoop = 1
            yearLoop = yearLoop + 1
        End If

    Loop

    GetMonthDays = months

End Function

我一直在使用以下函数对其进行测试:

Sub TestRun()

    Dim months() As Integer

    months = GetMonthDays(#12/25/2009#, #1/15/2011#)

    MsgBox _
        months(1) & vbCrLf & _
        months(2) & vbCrLf & _
        months(3) & vbCrLf & _
        months(4) & vbCrLf & _
        months(5) & vbCrLf & _
        months(6) & vbCrLf & _
        months(7) & vbCrLf & _
        months(8) & vbCrLf & _
        months(9) & vbCrLf & _
        months(10) & vbCrLf & _
        months(11) & vbCrLf & _
        months(12)

End Sub

这至少应该是一个很好的起点。祝你好运!