fundo
Como você sabe, "a preguiça é o motor do progresso." No meu trabalho, uma vez tive um problema quando era necessário fazer uma tabela para calcular os juros de um contrato de empréstimo, onde o número real de dias em um ano deveria ser para a base. O inconveniente era não se esquecer dos anos bissextos e separar os dias que pertencem ao ano bissexto e os dias dos anos não bissextos. Uma fórmula simples foi escrita, mas depois descobri que calcular anos bissextos não é tão simples.
Descrição do problema
Eu queria melhorar a fórmula. Na Internet, encontrei muitos textos de programas em que o número de anos e dias bissextos ou não bissextos em um período era calculado. Mas, infelizmente, não fiquei satisfeito com o fato de a velocidade dessas funções depender do número de anos no período. E eu queria que a função funcionasse com a mesma rapidez, não importa quantos anos no período. Mas durante o desenvolvimento, tive que limitar o período permitido da função.
Razão 1
A maioria dos países vive de acordo com o calendário gregoriano, cujas regras para os anos bissextos foram determinadas em 1582 pelo Papa Gregório XIII :
1. Um ano cujo número é divisível por 400 é um ano bissexto;
2. O resto dos anos, cujo número é um múltiplo de 100, são anos não bissextos (por exemplo, os anos 1700, 1800, 1900, 2100, 2200,2300)
3. , 4, - .
2900, 3200, 4000, 01.01.2900.
2
Excel VBA (Visual Basic for Applications). , MS Office, .
Excel , 1900 1904. 1900. , 1 01 1900 , 2 – 2 .
VBA CDate(expression), Date . 1, Date 31 1899 . 60 CDate 28.02.1900, 29.02.1900 (, , 1900 ). , 01 1900 .
Excel, Microsoft , . 01 1900 .
, () , .
, 4, 4 () 1 . 1- 1 4, 2- 5 8 .
1 4 (, 2021 506- , 1)
3 :
:
:
, , :
, , :
, , , 1- 366 ( 1 3, ).
VBA:
Private Function first_quartet_leap_year_days(ByVal d_begin As Date, ByVal d_end As Date) As Long
Dim result As Long
result = 0
Dim year_diff As Long
Dim quartet_index_diff As Long
year_diff = year(d_end) - year(d_begin)
quartet_index_diff = quartet_index(year(d_end)) - quartet_index(year(d_begin))
If year_diff = 0 And is_year_leap(d_begin) Then
result = DateDiff("d", d_begin, d_end)
first_quartet_leap_year_days = result
Exit Function
End If
If quartet_index_diff = 0 Then
If is_year_leap(d_begin) Then
result = DateDiff("d", d_begin, CDate(DateSerial(year(d_begin), 12, 31)))
first_quartet_leap_year_days = result
Exit Function
End If
If is_year_leap(d_end) Then
result = DateDiff("d", CDate(DateSerial(year(d_end) - 1, 12, 31)), d_end)
first_quartet_leap_year_days = result
Exit Function
End If
Else
If is_year_leap(d_begin) Then
result = DateDiff("d", d_begin, CDate(DateSerial(year(d_begin), 12, 31)))
first_quartet_leap_year_days = result
Exit Function
Else
If Not is_quartet_noleap(quartet_index(year(d_begin))) Then
result = 366
first_quartet_leap_year_days = result
Exit Function
End If
End If
End If
first_quartet_leap_year_days = result
End Function
>0, 3- " ".
, , :
Private Function last_quartet_leap_year_days(ByVal d_begin As Date, ByVal d_end As Date) As Long
Dim result As Long
result = 0
Dim quartet_index_diff As Long
quartet_index_diff = quartet_index(year(d_end)) - quartet_index(year(d_begin))
If quartet_index_diff > 0 Then
If is_year_leap(d_end) Then
result = DateDiff("d", CDate(DateSerial(year(d_end) - 1, 12, 31)), d_end)
End If
End If
last_quartet_leap_year_days = result
End Function
>1, 2- " ".
– . 1999 – 19, 2001 – 20, 1.
400-.
Private Function middle_quartets_leap_year_days(ByVal d_begin As Date, ByVal d_end As Date) As Long
Dim quartet_count As Long
quartet_count = middle_quartets_count(d_begin, d_end)
If quartet_count = 0 Then
middle_quartets_leap_year_days = 0
Exit Function
End If
Dim q_begin, q_end As Long
q_begin = quartet_index(year(d_begin))
q_end = quartet_index(year(d_end)) - 1
Dim quot_25, quot_100 As Integer
quot_25 = WorksheetFunction.Quotient(q_end, 25) - WorksheetFunction.Quotient(q_begin, 25)
quot_100 = WorksheetFunction.Quotient(q_end, 100) - WorksheetFunction.Quotient(q_begin, 100)
Dim result As Long
result = (quartet_count - quot_25 + quot_100) * 366
middle_quartets_leap_year_days = result
End Function
:
Public Function LEAP_DAYS(ByVal val_begin As Long, ByVal val_end As Long, Optional count_first_day = 0, Optional count_last_day = 1) As Long
Dim d_begin, d_end As Date
count_first_day = IIf(count_first_day <> 0, 1, 0)
count_last_day = IIf(count_last_day <> 0, 1, 0)
d_begin = CDate(val_begin)
d_end = CDate(val_end)
Dim check_error As Variant
check_error = check_constrains(d_begin, d_end)
If IsError(check_error) Then
LEAP_DAYS = check_error
Exit Function
End If
Dim result As Long
result = 0
If is_year_leap(d_begin) And count_first_day = 1 Then result = result + 1
If is_year_leap(d_end) And count_last_day = 0 Then result = result - 1
result = result + first_quartet_leap_year_days(d_begin, d_end) _
+ middle_quartets_leap_year_days(d_begin, d_end) _
+ last_quartet_leap_year_days(d_begin, d_end)
LEAP_DAYS = result
End Function
count_first_day
count_last_day
1 0. Date . .
, , . 23-24 .
, .
, . , (2900 - 1900). , 2900 .
Abaixo segue um link para o github, onde é apresentada a implementação completa das funções de cálculo de dias bissextos e comuns em um período em VBA, projetadas para funcionar em Excel. Você pode facilmente portar esta função para o seu idioma favorito e usá-la em seus projetos.
Fontes e links adicionais
Artigo da revista "Livro Geral" "Calculamos os juros do empréstimo: primeiro dia, último dia"
O Excel assume incorretamente que 1900 é um ano bissexto.
Artigo da Wikipedia "Calendário Gregoriano"