Рассчитать период на основе заданных дат

ProgramBox

Рассчитать период на основе заданных дат

Post author:admin
Запись опубликована:22 марта, 2023
Post category:Вопросы по программированию

#excel #vba #excel-2010

Вопрос:

У меня есть определенные даты в столбце O от O5 до O1200. Мне нужно определить, к какому периоду относится эта дата, а затем вернуть период в столбце AO от AO5 до AO1200. Диапазон данных для разных периодов приведен на рисунке ниже.

Диапазон данных для разных периодов

Изначально я использовал формулу для его вычисления, но я хочу автоматизировать процесс. Код выглядит следующим образом:

 =IF(ISBLANK(B5)=TRUE,"",IF(ISBLANK(O5)=TRUE,"Missing PSD",@IFERROR(IFS(
AND(O5>=Calendar!$B$3,O5<=Calendar!$C$3),"P01",
AND(O5>=Calendar!$B$4,O5<=Calendar!$C$4),"P02",
AND(O5>=Calendar!$B$5,O5<=Calendar!$C$5),"P03",
AND(O5>=Calendar!$B$6,O5<=Calendar!$C$6),"P04",
AND(O5>=Calendar!$B$7,O5<=Calendar!$C$7),"P05",
AND(O5>=Calendar!$B$8,O5<=Calendar!$C$8),"P06",
AND(O5>=Calendar!$B$9,O5<=Calendar!$C$9),"P07",
AND(O5>=Calendar!$B$10,O5<=Calendar!$C$10),"P08",
AND(O5>=Calendar!$B$11,O5<=Calendar!$C$11),"P09",
AND(O5>=Calendar!$B$12,O5<=Calendar!$C$12),"P10",
AND(O5>=Calendar!$B$13,O5<=Calendar!$C$13),"P11",
AND(O5>=Calendar!$B$14,O5<=Calendar!$C$14),"P12"
),IF((DATE(2019,10,1)-O5)>0,"FY20 or before",IF((DATE(2019,10,1)-O5)<0,"FY22 ","")))))

Как уже упоминалось, я хочу автоматизировать этот процесс и выполнять вычисления на VBA вместо вставки формулы в столбец Excel.

Любая помощь была бы высоко оценена.

1. Итак, содержит ли столбец O ошибки? Если да, то как вы вычисляете DATE(2019,10,1)-O5) , является ли O5 ошибкой?

2. Нет, столбец O не содержит ошибок. Если ДАТА (2019,10,1)-O5)> 0, то это часть предыдущего отчетного года, а если это ДАТА (2019,10,1)-O5)<0, то это часть следующего отчетного года. Мы хотим сосредоточиться только на периодах текущего отчетного года. Поэтому мы упоминаем 20-й финансовый год или ранее или финансовый год . Но для дат в текущем отчетном году я хочу отобразить период.

3. Приведенная вами формула мне нравится, зачем использовать VBA tho?

4. Прежде всего, почему бы не использовать цикл для выполнения от O5 до O 1200. Вычитая 5 из 2019/10/1, вы можете очистить эти цифры.?

5. Я не вычитаю 5. Я вычитаю дату в столбце «O5». Эта формула — это просто формула, которую я ввел в столбец AO5. Я хочу, чтобы это был цикл

Ответ №1:

Используя универсальную функцию (ниже), вам даже не нужна таблица диапазона дат, поскольку период может быть рассчитан непосредственно с любой даты. Затем ваша формула становится:

 =FinancialPeriod(CellReferenceWithDate)

 Option Explicit

    Public Const MaxWeekdayCountInMonth As Integer = 5
    Public Const DaysPerWeek            As Long = 7

' Returns the financial period of a calendar date.
'
' 2020-09-20. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function FinancialPeriod(ByVal Date1 As Date) As String

    Const FirstPeriod   As Integer = 1
    Const LastPeriod    As Integer = 12
    Const FirstMonth    As Integer = 10
    Const FirstDay      As Integer = 1
    Const MaximumDay    As Integer = 25
    Const Occurrence    As Integer = 4
    Const PeriodFormat  As String = "P00"
    
    Dim YearStart       As Date
    Dim PeriodEnd       As Date
    Dim Period          As Integer
    
    YearStart = DateSerial(Year(Date1) - Abs(Month(Date1) < FirstMonth), FirstMonth, FirstDay)
    For Period = FirstPeriod To LastPeriod - 1
        PeriodEnd = DateWeekdayInMonth(DateAdd("m", Period - 1, YearStart), Occurrence, vbFriday)
        If Day(PeriodEnd) > MaximumDay Then
            PeriodEnd = DateAdd("ww", -1, PeriodEnd)
        End If
        If Date1 <= PeriodEnd Then
            Exit For
        End If
    Next
    
    FinancialPeriod = Format(Period, PeriodFormat)
    
End Function

' Calculates the date of the occurrence of Weekday in the month of DateInMonth.
'
' If Occurrence is 0 or negative, the first occurrence of Weekday in the month is assumed.
' If Occurrence is 5 or larger, the last occurrence of Weekday in the month is assumed.
'
' If Weekday is invalid or not specified, the weekday of DateInMonth is used.
'
' 2019-12-08. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateWeekdayInMonth( _
    ByVal DateInMonth As Date, _
    Optional ByVal Occurrence As Integer, _
    Optional ByVal Weekday As VbDayOfWeek = vbUseSystemDayOfWeek) _
    As Date
    
    Dim Offset          As Integer
    Dim Month           As Integer
    Dim Year            As Integer
    Dim ResultDate      As Date
    
    ' Validate Weekday.
    Select Case Weekday
        Case _
            vbMonday, _
            vbTuesday, _
            vbWednesday, _
            vbThursday, _
            vbFriday, _
            vbSaturday, _
            vbSunday
        Case Else
            ' vbUseSystemDayOfWeek, zero, none or invalid value for VbDayOfWeek.
            Weekday = VBA.Weekday(DateInMonth)
    End Select
    
    ' Validate Occurence.
    If Occurrence < 1 Then
        ' Find first occurrence.
        Occurrence = 1
    ElseIf Occurrence > MaxWeekdayCountInMonth Then
        ' Find last occurrence.
        Occurrence = MaxWeekdayCountInMonth
    End If
    
    ' Start date.
    Month = VBA.Month(DateInMonth)
    Year = VBA.Year(DateInMonth)
    ResultDate = DateSerial(Year, Month, 1)
    
    ' Find offset of Weekday from first day of month.
    Offset = DaysPerWeek * (Occurrence - 1)   (Weekday - VBA.Weekday(ResultDate)   DaysPerWeek) Mod DaysPerWeek
    ' Calculate result date.
    ResultDate = DateAdd("d", Offset, ResultDate)
    
    If Occurrence = MaxWeekdayCountInMonth Then
        ' The latest occurrency of Weekday is requested.
        ' Check if there really is a fifth occurrence of Weekday in this month.
        If VBA.Month(ResultDate) <> Month Then
            ' There are only four occurrencies of Weekday in this month.
            ' Return the fourth as the latest.
            ResultDate = DateAdd("d", -DaysPerWeek, ResultDate)
        End If
    End If
    
    DateWeekdayInMonth = ResultDate
  
End Function

Я загрузил демонстрационную версию с датами за год для загрузки здесь.

Ответ №2:

Попробуйте с этим. Я думаю, что у меня все правильно. Обратите внимание, чтобы изменить имя листа для листа, на котором указаны ваши даты и выходные данные, поскольку оно не указано в вашем вопросе.

Еще одно примечание: i2 = от 3 до 14 — это диапазон вашего списка календаря. Измените по мере необходимости, я просто основал его на вашей формуле. А также столбец «A» в календарном листе, имеющий значения «PO», которые этот код использует для получения значения.

 Dim i1 As Long, i2 As Long, Cal As Worksheet, Data As Worksheet, OldDate As Date

Set Cal = Sheets("Calendar")
Set Data = Sheets("Sheet1") 'Need to change this to the sheet with the dates/output
OldDate = DateValue("1 Oct, 2019")

For i1 = 5 To 1200 'Your range of dates
    If Data.Range("B" amp; i1) <> "" Then
        If Data.Range("O" amp; i1) = "" Then
            Data.Range("AO" amp; i1) = "Missing PSD"
        Else
            For i2 = 3 To 14 'Your range within the Calendar sheet your are checking against
                If Data.Range("O" amp; i1) >= Cal.Range("B" amp; i2) And Data.Range("O" amp; i1) <= Cal.Range("C" amp; i2) Then
                    Data.Range("AO" amp; i1) = Cal.Range("A" amp; i2)
                    GoTo Nexti1
                End If
            Next i2
            If OldDate - Data.Range("O" amp; i1) > 0 Then
                Data.Range("AO" amp; i1) = "FY20 or before"
            ElseIf OldDate - Data.Range("O" amp; i1) < 0 Then
                Data.Range("AO" amp; i1) = "FY22 "
            End If
        End If
    End If
Nexti1:
Next i1

1. Это работает отлично. Я получаю требуемый результат. Но что, если я хочу сохранить даты в VBA? На самом деле я хочу удалить лист календаря и сохранить значения даты со значениями периода в модуле VBA.

2. Это требует гораздо больше работы, и я не хочу тратить на это время. Это также сделает код намного больше, чтобы вам приходилось указывать каждую дату, а также значения «PO». Это можно сделать в массиве, но опять же, это не меньшая задача, с которой я не совсем справляюсь. Могу ли я предложить вместо удаления календаря просто скрыть лист, поэтому он вам не мешает, и вы всегда можете вернуться к нему в будущем. Код по-прежнему работает со скрытым листом, и если это не так, мы можем отобразить / изменить его в коде.