如何创建类似于DateDiff的查询/ vba函数,将结果拆分为每月的天数(即2010年1月1日 - 2010年2月3日= 1月:31日,2月3日(无视格式))。
答案 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
这至少应该是一个很好的起点。祝你好运!