DateDiff分成几个月access/vba

Question

如何创建一个类似于DateDiff的查询/ vba函数，将结果拆分为每月的天数（即2010年1月1日 - 2010年2月3日= 1月31日，2月： 3（忽略格式））。

Answer 1

好吧，我想我明白你想要做什么。

首先你需要返回一个月的天数的函数，给出年份和月份（你要知道当年占到由于闰年二月变化的天数）：

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）和两个12月（31 + 7）。我不是100％确定这是你想要的，但是如果给定的日期范围跨越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 

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