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 FunctionAlcune 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: |