DateDiff разделен на месяцы доступа / VBA - PullRequest
Новая
       18

DateDiff разделен на месяцы доступа / VBA

1 голос
/ 06 октября 2011

Как создать функцию запроса / vba, аналогичную DateDiff, которая разбивает результат на дни в месяце (т. Е. 1 января 2010 года - 3 марта 2010 года = январь: 31, февраль: 3 (без учета форматирования)).

1 Ответ

1 голос
/ 06 октября 2011

ОК, я думаю, что вижу, что вы хотите сделать.

Прежде всего вам нужна функция, которая возвращает количество дней в месяце, учитывая месяц и год (вам нужно знать годдля учета изменения количества дней в феврале из-за високосных лет): 

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]

Вы можете видеть, что он накопил количество дней задва января (31 + 15) и два декабря (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

Это должно быть хорошей отправной точкой для вас, по крайней мере.Удачи!

...