calcolare anni mesi giorni da una data

[lavespa]

salve
ho bisogno del vostro aiuto

allego un file in cui c'è una Public Function che calcola il tempo
trascorso da una data ma non si aggiorna automaticamente,
devo fare doppio clic nella cella perché accada l'evento
e poi, possibilmente, quando gli anni o mesi o giorni sono
a "0" non si visualizzassero
es.:
non così: 0 anni 0 mesi 0 giorni
ma così: 0 giorni
non così: 3 anni 0 mesi 2 giorni
ma così: 3 anni 2 giorni
ecc.:

http://www.filedropper.com/esempio_7

spero di avervi fatto capire,
non so se sia fattibile ma sicuramente io
non saprei come modificarlo

Grazie

[Anthony47]

Non offenderti se non ti aiuto a far funzionare quell'obrobrio
Puoi ottenere il risultato usando in E6 la formula

Codice: Seleziona tutto

=SE(DATA.DIFF(C6;OGGI();"y")>0;DATA.DIFF(C6;OGGI();"y") & " Anni ";"") & SE(DATA.DIFF(C6;OGGI();"ym")>0;DATA.DIFF(C6;OGGI();"ym") & " Mesi ";"") & DATA.DIFF(C6;OGGI();"md") & " Giorni"


Per la cronaca, la Funzione utilizzata nel file pubblicato corrisponde a questo codice:

Codice: Seleziona tutto

Public Function Eta(Nascita As Date, Optional DataCorrente As Variant) As String
'Se non metti la data corrente prende in automatico la data odierna
If IsMissing(DataCorrente) Then DataCorrente = Date
Dim Anni As Integer
Dim Mesi As Integer
Dim Giorni As Integer
'Calcolo gli anni
    Anni = Year(DataCorrente) - Year(Nascita)
    If DateSerial(Year(DataCorrente), Month(Nascita), Day(Nascita)) > DataCorrente Then
        Anni = Anni - 1
    End If

'Calcolo i mesi
    If Month(Nascita) = Month(DataCorrente) Then
        If Day(Nascita) < Day(DataCorrente) Then
            Mesi = 0
        End If
        If Day(Nascita) > Day(DataCorrente) Then
            Mesi = 11
        End If
    End If
    If Month(Nascita) > Month(DataCorrente) Then
        Mesi = 12 - Month(Nascita) + Month(DataCorrente)
        If Day(Nascita) > Day(DataCorrente) Then
            Mesi = Mesi - 1
        End If
    End If
    If Month(Nascita) < Month(DataCorrente) Then
        Mesi = Month(DataCorrente) - Month(Nascita)
        If Day(Nascita) > Day(DataCorrente) Then
            Mesi = Mesi - 1
        End If
    End If
'Calcolo i giorni
    If Month(Nascita) < Month(DataCorrente) Then
        If Day(Nascita) > Day(DataCorrente) Then
            Giorni = Day(DateSerial(Year(DataCorrente), Month(Nascita) + 1, 0)) - Day(Nascita) + Day(DataCorrente)
        End If
        If Day(Nascita) < Day(DataCorrente) Then
            Giorni = Day(DataCorrente) - Day(Nascita)
        End If
    End If
    If Month(Nascita) = Month(DataCorrente) Then
        If Day(Nascita) > Day(DataCorrente) Then
            Giorni = Day(DateSerial(Year(DataCorrente), Month(Nascita), 0)) - Day(Nascita) + Day(DataCorrente)
        End If
        If Day(Nascita) < Day(DataCorrente) Then
            Giorni = Day(DataCorrente) - Day(Nascita)
        End If
    End If
    If Month(Nascita) > Month(DataCorrente) Then
        If Day(Nascita) > Day(DataCorrente) Then
            Giorni = Day(DateSerial(Year(DataCorrente), Month(Nascita) + 1, 0)) - Day(Nascita) + Day(DataCorrente)
        End If
        If Day(Nascita) < Day(DataCorrente) Then
            Giorni = Day(DataCorrente) - Day(Nascita)
        End If
    End If

    Eta = Anni & IIf(Anni <= 1, " anno ", " anni ") & Mesi & IIf(Mesi <= 1, " mese ", " mesi ") & Giorni & IIf(Giorni <= 1, " giorno", " giorni")

End Function


Ciao

[lavespa]

Anthony ti ringrazio molto per la cortesia

non per forza devo usare quell'obrobrio ma è l'unico trovato che calcola gli anni prima del 1900

come formula uso questa

Codice: Seleziona tutto

=SE(C6>0;ANNULLA.SPAZI(SE(OGGI()-C6;TESTO(DATA.DIFF(C6;OGGI();"y");"[>1]0"" anni"";[>]""1 anno"";")&TESTO(DATA.DIFF(C6;OGGI();"ym");"[>1] 0 "" mesi "";[>]"" 1 mese""; ")&TESTO(DATA.DIFF(C6;OGGI();"md");"[>1] 0 "" giorni"";[>]"" 1 giorno"";");" 0 giorno"));"")

se la formula che hai postato o questa si potessero modificare allo scopo per me andrebbe bene lo stesso

grazie ancora

Ciao

[Anthony47]

Se hai date anteriori al 1900 allora:

Codice: Seleziona tutto

Function Eta2(ByVal DInit As Date, Optional dEnd As Date = 0) As String
Dim dY As Long, cYY As Long, cMM As Long, cDD As Long, myOut As String
'
DInit = Int(DInit)
If dEnd = 0 Then dEnd = Date
If Year(DInit) < 1901 Then
    dY = 1901 - Year(DInit)
    DInit = DateSerial(1901, Month(DInit), Day(DInit))
End If
'
cYY = Evaluate("=DATEDIF(" & CLng(DInit) & "," & CLng(dEnd) & ", ""Y"")")
cMM = Evaluate("=DATEDIF(" & CLng(DInit) & "," & CLng(dEnd) & ", ""YM"")")
cDD = Evaluate("=DATEDIF(" & CLng(DInit) & "," & CLng(dEnd) & ", ""MD"")")
'
If (cYY + dY) > 1 Then myOut = cYY + dY & " Anni "
If (cYY + dY) = 1 Then myOut = cYY + dY & " Anno "
If cMM > 1 Then myOut = myOut & cMM & " Mesi "
If cMM = 1 Then myOut = myOut & cMM & " Mese "
'If Len(myOut) = 0 Then
    If cDD > 1 Or cDD = 0 Then myOut = myOut & cDD & " Giorni "
    If cDD = 1 Then myOut = myOut & cDD & " Giorno "
'End If
Eta2 = myOut
End Function


La sintassi per l'utilizzo di questa ETA2 e' la stessa della ETA

Ciao

[lavespa]

ciao Anthony

intanto grazie di avermi dedicato del tempo

purtroppo mi ero concentrato su quella macro e non avevo fatto altre prove
ora che mi hai postato quella giusta, implementandola con un'altra si crea un altro problema

ti spiego

se la persona nasce prima del 1900 e muore dopo il 1900 funziona (vedi righe verdi)
se la persona nasce prima del 1900 e muore prima del 1900 non funge (vedi righe gialla)

http://www.filedropper.com/prova2_1

ma se premi fx nella barra delle formule nella maschera che si apre il risultato giusto c'è
perché non lo riporta nella cella?

dov'è lo sbaglio?

Ciao

[Anthony47]

Capisco il problema delle date di fine <1900, ma non ho capito come hai applicato la ETA2 in colonna E, visto che il parametro passatogli e' la data di Morte non la data di Nascita.

Comunque per tener conto anche della data finale potenzialmente inferiore al 1900, ecco la versione 3.

Codice: Seleziona tutto

Function Eta3(ByVal DIn As String, Optional dOut As String = "") As Variant
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109035
'
Dim dY As Long, cYY As Long, cMM As Long, cDD As Long, myOut As String
Dim dE As Long, DInit As Date, DEnd As Date
'
DInit = DateSerial(Year(DIn), Month(DIn), Day(DIn))
DEnd = DateSerial(Year(dOut), Month(dOut), Day(dOut))
If DEnd < DInit Then Eta3 = CVErr(xlErrNA): Exit Function
If Month(DateSerial(Year(DIn), 2, 29)) = 2 Then myc = 1904 Else myc = 1903
If DEnd = 0 Then DEnd = Date
If Year(DInit) < myc Then
    dY = myc - Year(DInit)
    DInit = DateSerial(myc, Month(DInit), Day(DInit))
End If
If Month(DateSerial(Year(DEnd), 2, 29)) = 2 Then myc = 1908 Else myc = 1907
If Year(DEnd) < myc Then
    dE = myc - Year(DEnd)
    DEnd = DateSerial(myc, Month(DEnd), Day(DEnd))
End If
'
cYY = Evaluate("=DATEDIF(" & CLng(DInit) & "," & CLng(DEnd) & ", ""Y"")")
cMM = Evaluate("=DATEDIF(" & CLng(DInit) & "," & CLng(DEnd) & ", ""YM"")")
cDD = Evaluate("=DATEDIF(" & CLng(DInit) & "," & CLng(DEnd) & ", ""MD"")")
'
If (cYY + dY - dE) > 1 Then myOut = cYY + dY - dE & " Anni "
If (cYY + dY - dE) = 1 Then myOut = cYY + dY - dE & " Anno "
If cMM > 1 Then myOut = myOut & cMM & " Mesi "
If cMM = 1 Then myOut = myOut & cMM & " Mese "
'If Len(myOut) = 0 Then
    If cDD > 1 Or (cDD = 0 And Len(myOut) = 0) Then myOut = myOut & cDD & " Giorni "
    If cDD = 1 Then myOut = myOut & cDD & " Giorno "
'End If
Eta3 = myOut
End Function

Ti anticipo che non tiene conto dei giorni compensati nel passaggio tra il calendario Giuliano e quello Gregoriano.
A spanne mi sembra dia risultati piu' coerenti che non la Diff2Dates, presente nel tuo file.

Ciao

[lavespa]

Buonasera

mi scuso per il ritardo

Anthony hai ragione sulla colonna E, è fuorviante in quanto non ne ho parlato,
prende dalla colonna D perché rappresenta l'anniversario di morte

riepilogando il risultato da raggiungere e questo:
quando metto la data in colonna B, in colonna C comincia la conta, quando metto la data in colonna D
si blocca colonna C e comincia in Colonna E

per quanto riguarda ETA3 se non ho capito male la devo mettere al posto di Diff2Dates e cosi ho fatto,
o devo impostarla in altro modo?

funziona tutto finchè non ci sono tutte e due le date antecedenti al 1900
in C9 con data di morte inserita in D9 deve essere 88 anni 2 mesi 15 giorni
in C11 con data inserita in D11 deve essere 66 anni 17 giorni
questi risultati vengono calcolati dalla funzione ma non li inserisce nella cella
perché?

http://www.filedropper.com/prova3

Ciao

[Anthony47]

Eta3 doveva essere la variante di Eta2 per gestire anche date di termine prima del 1900.
Usala secondo la sintassi valida per ETA ed ETA2

Purtroppo ho dimenticato di gestire il caso che la data di termine sia vuota. Modifca la parte iniziale di ETA3 aggiungendo questa riga:

Codice: Seleziona tutto

Function Eta3(ByVal DIn As String, Optional dOut As String = "") As Variant
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109035
'
Dim dY As Long, cYY As Long, cMM As Long, cDD As Long, myOut As String
Dim dE As Long, DInit As Date, DEnd As Date
'
If dOut = "" Then dOut = Format(Date, "dd/mm/yyyy")     'AGGIUNGERE!!!
DInit = DateSerial(Year(DIn), Month(DIn), Day(DIn))
'etc etc

A questo punto la formula in C3 diventa

Codice: Seleziona tutto

=SE(B3<>"";Eta3(B3;D3);"")

In riga 9 il risultato e' 88 Anni 2 Mesi 15 Giorni

Ciao

[lavespa]

Molte grazie Anthony
ora funziona benissimo
come sempre risolvi tutto

ciao

[lavespa]

Anthony scusa ma non si aggiorna

Ciao

[Anthony47]

La funzione si aggiorna quando il suo parametro si modifica.
Controlla di avere impostato il calcolo su Automatico.

Ciao

[lavespa]

rispondo in ritardo perché ho cercato di trovare una soluzione
e dopo un giorno di ricerche, prove e mal di testa sono arrivato a questo:

in ThisWorkbook

Codice: Seleziona tutto

Private Sub Workbook_Open()
Application.CalculateFull
End Sub


per aggiornare aggiorna ma non so quanto sia consono,
la mia conoscenza di excel è limitata,
se c'è una soluzione più adeguata sono sempre pronto ai miglioramenti.

Ciao