General

6.45 Differenza tra due date espressa in anni, mesi e giorni.
  Silvio Berruti
Public Function DiffDate(Data1 As String, Data2 As String) As String
' Questa funzione calcola la differenza tra due date (Data1 - Data2)
' esprimendo il risultato in anni, mesi e giorni.
' Le date devono essere inserite in formato testo.
' In realtà funziona anche inserendo le date in formato data, ma
' possono crearsi errori dovuti all'interpretazione delle stesse.
' Esempio: #18/02/1999# = "18/02/1999", ma #08/02/1999# = "02/08/1999"
  On Error GoTo Errore_Diffdate
  Dim anni, mesi, giorni, gnm
  ' Vengono calcolate le differenze per anni, mesi e giorni
  anni = Year(Data1) - Year(Data2)
  mesi = Month(Data1) - Month(Data2)
  giorni = Day(Data1) - Day(Data2)
  ' Esegue il controllo per gli anni bisestili
  If Year(Data2) \ 4 = Year(Data2) / 4 And Month(Data2) = 2 Then
    gnm = GiorniNelMese(Month(Data2)) + 1
  Else
    gnm = GiorniNelMese(Month(Data2))
  End If
  ' Vengono apportate le correzioni di range
  If giorni < 0 Then mesi = mesi - 1: giorni = gnm + giorni
  If giorni > gnm Then mesi = mesi + 1: giorni = giorni - gnm
  If mesi < 0 Then anni = anni - 1: mesi = 12 + mesi
  If mesi > 12 Then anni = anni + 1: mesi = mesi - 12
  ' Visualizza il risultato
  If anni < 0 Then
    DiffDate = "Date invertite"
  Else
    DiffDate = "a=" & anni & " m=" & mesi & " g=" & giorni
  End If
Exit_Diffdate:
  Exit Function
Errore_Diffdate:
  Select Case Err
    Case 13: DiffDate = "Data errata o non esistente"
    Case 94: DiffDate = "Inserire una data"
    Case Else: DiffDate = "Errore non previsto"
  End Select
  Resume Exit_Diffdate
End Function

Function GiorniNelMese(Mese)
  ' Calcola quanti giorni ha il mese
  ' Questa funzione non controlla gli anni bisestili
  Select Case Mese
    Case 1, 3, 5, 7, 8, 10, 12: GiorniNelMese = 31
    Case 2: GiorniNelMese = 28
    Case Else: GiorniNelMese = 30
  End Select
End Function


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.