开发者

DateDiff split into months access/vba

开发者 https://www.devze.com 2023-04-11 15:05 出处:网络
How would I create a query/vba function similar 开发者_运维百科to DateDiff that splits the result into days per month (i.e. 1/1/2010 - 2/3/2010 = January: 31, February: 3 (disregarding formatting)).OK

How would I create a query/vba function similar 开发者_运维百科to DateDiff that splits the result into days per month (i.e. 1/1/2010 - 2/3/2010 = January: 31, February: 3 (disregarding formatting)).


OK, I think I see what you want to do.

First of all you need a function that returns the number of days in a month, given the month and year (you need to know the year to account for changing number of days in February owing to leap years):

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

I've written a function GetMonthDays that takes the start date and end date and returns an array (1 to 12) of integers, containing the number of days in each month, between the specified start and end dates. The start and end dates can be any number of years apart, it will accumulate the total number of days in each month over a period of multiple years if necessary.

For example, a function call such as:

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

would return an array [0,0,0,0,0,18,31,1,0,0,0,0]

A call such as:

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

returns [15,0,0,0,0,0,0,0,0,0,0,7]

Over multiple years, for example:

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

it would return [46,28,31,30,31,30,31,31,30,31,30,38]

You can see that it has accumulated the number of days across two Januarys (31 + 15) and two Decembers (31 + 7). I'm not 100% sure this is what you want, but it makes sense to me if given a date range spanning more than 12 months.

Basically, the function loops through each month between the start and end dates and accumulates the days in each. The first and last month are special cases where a little calculation is required, otherwise it's simply the number of days in the month.

The function is as follows, minus error checking:

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

I've been testing it using a function such as:

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

This should be a good starting point for you at the very least. Good luck!

0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号