| Modules |
| 5.60 Differenza tra due oggetti di tipo Data/ora in anni, mesi, giorni, ore, minuto e secondi |
| Carlo Costarella, Roberto, UBI |
Qui di seguito è mostrato il codice VBA di una funzione che calcola il numero di anni, mesi, giorni, ore, minuti e secondi esistenti tra due oggetti di tipo Data/ora.Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _
Optional ShowZero As Boolean = False) As Variant
'Descrizione: Questa funzione calcola il numero di anni,
' mesi, giorni, ore, minuti e secondi esistenti tra
' due oggetti di tipo Data/ora
'
'Inputs: Interval: Stringa che indica il formato del risultato
' Date1: Prima variabile di tipo Data/ora (inizio periodo)
' Date2: Seconda variabile di tipo Data/ora (fine periodo)
' ShowZero: Variabile booleana che indica se nel risultato
' vanno mostrati i valori uguali a zero
'
'Outputs: In caso di errore: viene restituito un risultato Null
' In caso di non errore: Variant contiene il numerodi anni,
' mesi, giorni, ore, minuti e secondi compresi tra
' le due date, A seconta di quanto scelto con la stringa
' Interval.
' Se Date1 è maggiore di Date2, verrà restituito un
' risultato con valore negativo.
' La funzione compensa per ogni tipo di intervallo non
' richiesto. Per esempio, se Interval contiene "m", ma
' non "y", la funzione somma il valore degli anni
' moltiplicato 12 ai mesi.
' Se ShowZero è True, e un elemento di output è zero, esso viene
' comunque mostrato. Invece, se ShowZero é False o è
' omesso, gli elementi di valori zero non vengono mostrati.
' Per esempio, con ShowZero = False e Interval = "ym",
' elementi = rispettivamente a 0 & 1, la stringa dell'aoutput
' sarà "1 mese" e non "0 anni 1 mese".
'
'************** Esempi ***************
' Print Diff2Dates("y", #6/1/1998#, #6/26/2002#)
' Print Diff2Dates("ymd", #6/1/1998#, #6/26/2002#)
' Print Diff2Dates("ymd", #6/1/1998#, #6/26/2002#, True)
' Print Diff2Dates("d", #6/1/1998#, #6/26/2002#)
' Print Diff2Dates("h", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
' Print Diff2Dates("hns", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
' Print Diff2Dates("dhns", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
' Print Diff2Dates("ymd", #12/31/1999#, #1/1/2000#)
' Print Diff2Dates("ymd", #1/1/2000#, #12/31/1999#)
' Print Diff2Dates("ymd", #1/1/2000#, #1/2/2000#)
'***************** Fine esempi **************
On Error GoTo Err_Diff2Dates
Dim booCalcYears As Boolean
Dim booCalcMonths As Boolean
Dim booCalcDays As Boolean
Dim booCalcHours As Boolean
Dim booCalcMinutes As Boolean
Dim booCalcSeconds As Boolean
Dim booSwapped As Boolean
Dim dtTemp As Date
Dim intCounter As Integer
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
Dim lngDiffHours As Long
Dim lngDiffMinutes As Long
Dim lngDiffSeconds As Long
Dim varTemp As Variant
Const INTERVALS As String = "dmyhns"
'Controlla che Interval contenga solo valori validi
Interval = LCase$(Interval)
For intCounter = 1 To Len(Interval)
If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
Exit Function
End If
Next intCounter
'Verifica che si stanno usando due date valide
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function
'Se necessario, inverti le date, per essere
'sicuro che Date1 sia minore di Date2.
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
booSwapped = True
End If
Diff2Dates = Null
varTemp = Null
'Che intervallo è stato fornito
booCalcYears = (InStr(1, Interval, "y") > 0)
booCalcMonths = (InStr(1, Interval, "m") > 0)
booCalcDays = (InStr(1, Interval, "d") > 0)
booCalcHours = (InStr(1, Interval, "h") > 0)
booCalcMinutes = (InStr(1, Interval, "n") > 0)
booCalcSeconds = (InStr(1, Interval, "s") > 0)
'Calcola le differenze comulative
If booCalcYears Then
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
End If
If booCalcMonths Then
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
End If
If booCalcDays Then
lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
Date1 = DateAdd("d", lngDiffDays, Date1)
End If
If booCalcHours Then
lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
Date1 = DateAdd("h", lngDiffHours, Date1)
End If
If booCalcMinutes Then
lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
Date1 = DateAdd("n", lngDiffMinutes, Date1)
End If
If booCalcSeconds Then
lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
Date1 = DateAdd("s", lngDiffSeconds, Date1)
End If
If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " anni", " anno")
End If
If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
If booCalcMonths Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffMonths & IIf(lngDiffMonths <> 1, " mesi", " mese")
End If
End If
If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
If booCalcDays Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffDays & IIf(lngDiffDays <> 1, " giorni", " giorno")
End If
End If
If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
If booCalcHours Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffHours & IIf(lngDiffHours <> 1, " ore", " ora")
End If
End If
If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
If booCalcMinutes Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minuti", " minuto")
End If
End If
If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
If booCalcSeconds Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffSeconds & IIf(lngDiffSeconds <> 1, " secondi", " secondo")
End If
End If
If booSwapped Then
varTemp = "-" & varTemp
End If
Diff2Dates = Trim$(varTemp)
End_Diff2Dates:
Exit Function
Err_Diff2Dates:
Resume End_Diff2Dates
End Function
Alcune considerazione sul funzionamento della funzione possono esere lette nei commenti posti all'interno del codice VBA di cui sopra.Interval dovrà contenere: - anche il carattere y se si vuole che la differenza venga fatta anche in anni - anche il carattere m se si vuole che la differenza venga fatta anche in mesi - anche il carattere d se si vuole che la differenza venga fatta anche in giorni - anche il carattere h se si vuole che la differenza venga fatta anche in ore - anche il carattere n se si vuole che la differenza venga fatta anche in minuti - anche il carattere s se si vuole che la differenza venga fatta anche in secondi Non è necessario indicare tutti e sei i caratteri; se ad esempio si vuole che la differenza avvenga solo in minuti, si indicherà solo il carattere n. I due oggeti Data/ora potranno contenere solamente delle date (10/04/2005), solamente degli orari (12:20:45) oppure sia una data che un orario (10/04/2005 12:20:45). Download: |