DateDiff split into months access/vba
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!
精彩评论