modifica macro per calcolo date

Versione Completa   Stampa   Cerca   Utenti   Iscriviti     Condividi : FacebookTwitter
Excel Forum » Excel Forum » » Soluzioni Excel Domande e Risposte
maxma62
00venerdì 1 settembre 2017 21:45
Ciao a tutti.
La macro allegata è in inglese e non so come cambiare in questo punto: 

If Grammar = True Then

    'sGrammar(0) = "s" 'inglese
    sGrammar(0) = "i" 'taliano
    
End If


e poi qui: 

'italiano
If ShowAll Or iYears > 0 Then
    sYears = iYears & " anno" & sGrammar((iYears = 1)) & ", "
End If
If ShowAll Or iYears > 0 Or iMonths > 0 Then
    sMonths = iMonths & " mese" & sGrammar((iMonths = 1)) & ", "
End If
sDays = iDays & " giorno" & sGrammar((iDays = 1))


perchè poi in B1 esca (esempio)

4 anni, 3 mesi, 20 giorni

e non:

4 annoi, 3 mesei, 20 giornoi

Max



patel45
00sabato 2 settembre 2017 07:53
Re:
prova questa 
Function YearsMonthsDays(Date1 As Date, Date2 As Date) As String
Dim dTempDate As Date
Dim iYears As Integer
Dim iMonths As Integer
Dim iDays As Integer
Dim sYears As String
Dim sMonths As String
Dim sDays As String
Dim sGrammar As String
If Date1 > Date2 Then
    dTempDate = Date1
    Date1 = Date2
    Date2 = dTempDate
End If

iYears = DateDiff("yyyy", Date1, Date2)
Date1 = DateAdd("yyyy", iYears, Date1)
If Date1 > Date2 Then
    iYears = iYears - 1
    Date1 = DateAdd("yyyy", -1, Date1)
End If

iMonths = DateDiff("M", Date1, Date2)
Date1 = DateAdd("M", iMonths, Date1)
If Date1 > Date2 Then
    iMonths = iMonths - 1
    Date1 = DateAdd("m", -1, Date1)
End If

iDays = DateDiff("d", Date1, Date2)

If iYears > 0 Then
    If iYears = 1 Then sGrammar = "o" Else sGrammar = "i" ' <<<<<<
    sYears = iYears & " ann" & sGrammar & ", "
End If
If iYears > 0 Or iMonths > 0 Then
    If iMonths = 1 Then sGrammar = "e" Else sGrammar = "i" ' <<<<<<
    sMonths = iMonths & " mes" & sGrammar & ", "
End If
sDays = iDays & " giorni" 
YearsMonthsDays = sYears & sMonths & sDays
End Function



maxma62
00sabato 2 settembre 2017 08:57
Ciao patel,
grazie dell'aiuto.
La tua modifica non è tanto esatta, non esce il nome in plurale.
In più nel mio file allegato in post#1 nelle celle dove c'è la funzione:

=YearsMonthsDays(A1;A2;FALSO;VERO)
=YearsMonthsDays(A1;A2;VERO;FALSO)
=YearsMonthsDays(A1;A2;VERO;VERO)
=YearsMonthsDays(A1;A2;FALSO;FALSO)

si visualizza in modo diverso il formato delle date.
Con la tua macro ora in queste celle dà errore di #VALORE!.
max
patel45
00sabato 2 settembre 2017 09:36
nell'allegato c'è una sola formula, io ho eliminato il vero e falso quindi le formule devono riportare solo le date
Ho fatto qualche correzione alla macro precedente
maxma62
00sabato 2 settembre 2017 09:46
E' vero patel, nel post#1 ho allegato il file non esatto.
In questo c'è quello esatto.
max
cromagno
00sabato 2 settembre 2017 09:59
Ciao a tutti,

@max
la sintassi in inglese ed in italiano è completamente diversa...
in inglese basta aggiungere una "s" per il plurale, mentre in italiano devi SOSTITUIRE l'ultima lettera.
Quindi l'argomento "grammar" della funzione (così come la variabile "sGrammar") perde la sua utilità.

Potresti usare questa: 
Function YearsMonthsDays(Date1 As Date, _
    Date2 As Date, Optional ShowAll As Boolean = False, _
    Optional MinusText As String = "Minus ") As String
    
    
Dim dTempDate As Date
Dim iYears As Integer
Dim iMonths As Integer
Dim iDays As Integer
Dim sYears As String
Dim sMonths As String
Dim sDays As String
Dim sGrammar(-1 To 0) As String
Dim sMinusText As String

If Date1 > Date2 Then
    dTempDate = Date1
    Date1 = Date2
    Date2 = dTempDate
    sMinusText = MinusText
End If

iYears = DateDiff("yyyy", Date1, Date2)
Date1 = DateAdd("yyyy", iYears, Date1)
If Date1 > Date2 Then
    iYears = iYears - 1
    Date1 = DateAdd("yyyy", -1, Date1)
End If

iMonths = DateDiff("M", Date1, Date2)
Date1 = DateAdd("M", iMonths, Date1)
If Date1 > Date2 Then
    iMonths = iMonths - 1
    Date1 = DateAdd("m", -1, Date1)
End If

iDays = DateDiff("d", Date1, Date2)


If iYears > 0 Then
    If iYears = 1 Then
        sYears = iYears & "anno" & ", "
    Else
        sYears = iYears & " anni" & ", "
    End If
End If
If iMonths > 0 Then
    If iMonths = 1 Then
        sMonths = iMonths & " mese" & ", "
    Else
        sMonths = iMonths & " mesi" & ", "
    End If
End If
If iDays = 1 Then
    sDays = iDays & " giorno"
Else
    sDays = iDays & " giorni"
End If

YearsMonthsDays = sMinusText & sYears & sMonths & sDays

End Function


Ciao
Tore
rollis13
00sabato 2 settembre 2017 16:15
Un saluto a tutti.

Volevo segnalare a maxma62 che già nella Function originale c'è un errore di base: es. utilizzando come data iniziale 31/01/2017 e finale 01/02/2017 vengono segnalati ben 4 giorni di differenza mentre con altri mesi da 31 giorni la differenza con il primo del mese successivo indica 2 giorni. Non ho fatto prove con differenze negative tipo inizio 01/01/2017 fine 29/02/2016.
maxma62
00sabato 2 settembre 2017 16:42
Ah non ero accorto [SM=g27826]
Vediamo di trovare un'altra soluzione.
Grazie rollis della segnalazione.
max
dodo47
00sabato 2 settembre 2017 16:54
eh..eh
andrebbe detto a quelli di stackoverflow.com che hanno proposto la soluzione.
(Comunque il problema di quella udf è legato al mese successivo che se è di 31 calcola correttamente, altrimenti....

cari saluti


dodo47
00sabato 2 settembre 2017 17:20
ciao
proposta: 
Public Function GMA(Date1 As Date, Date2 As Date) As String
Dim intYears As Integer, intMonths As Integer, intDays As Integer
Dim iG As String, iM As String, iA As String
  intMonths = DateDiff("m", Date1, Date2)
  intDays = DateDiff("d", DateAdd("m", intMonths, Date1), Date2)
  If intDays < 0 Then
    intMonths = intMonths - 1
    intDays = DateDiff("d", DateAdd("m", intMonths, Date1), Date2)
  End If
  intYears = intMonths \ 12
  intMonths = intMonths Mod 12
  If intDays > 1 Or intDays = 0 Then iG = "giorni" Else iG = "giorno"
  If intMonths > 1 Or intMonths = 0 Then iM = "mesi" Else iM = "mese"
  If intYears > 1 Or intYears = 0 Then iA = "anni" Else iA = "anno"
  GMA = intYears & " " & iA & " " & intMonths & " " & iM & " " & intDays & " " & iG
End Function


Saluti

(nota: non è prevista la scritta corretta giorno/i mese/i anno/i per differenze negative in quanto nella tua convalida stabilisci che a1 deve essere minore di a2)


cromagno
00sabato 2 settembre 2017 17:22
Re:
maxma62, 02/09/2017 16.42:
Ah non ero accorto [SM=g27826]
Vediamo di trovare un'altra soluzione.
Grazie rollis della segnalazione.
max

Ciao a tutti,

@max
Non ho ancora capito se hai visto quello che ti ho proposto al post #6
[SM=g27833] [SM=g27833] [SM=g27833] [SM=g27833] [SM=g27833]
dodo47
00sabato 2 settembre 2017 17:29
Tore
sbaglio o anche la tua versione con date 31/01/2017 01/02/2017 restituisce 4 giorni? (il problema è sempre quello del mese successivo che se di 31 è ok, altrimenti...)

cari saluti


cromagno
00sabato 2 settembre 2017 17:33
Re:
dodo47, 02/09/2017 17.29:
Tore
sbaglio o anche la tua versione con date 31/01/2017 01/02/2017 restituisce 4 giorni? (il problema è sempre quello del mese successivo che se di 31 è ok, altrimenti...)

cari saluti


Ciao Domenico,
sicuramente.
Quello proposto era solo la modifica per la "conversione" in italiano...i bug natii non li ho presi in considerazione.

Ciao
Tore

maxma62
00sabato 2 settembre 2017 19:01
Ciao dodo47.
La tua macro mi sembra esatta.
Sto tentando di fare una piccola modifica alla tua macro, per visualizzare esempio se restano "2 mesi, 1 giorno" oppure "10 giorni"
aggiungendo una serie di else.
L'esempio per visualizzare solo "1 giorno" non risulta esatto.
Allego esempi.
max
maxma62
00sabato 2 settembre 2017 22:48
Ciao,
ho risolto in parte aggiungendo una serie di if-elseif else end if.
Una data non riesco capire perché esce così:

data inizio 31/03/2017
data fine 01/04/2017
esce: 0 anni, 0 mesi, 1 giorno
dovrebbe uscire: 1 giorno

invece:

data inizio 31/03/2017
data fine 02/04/2017
esce: 2 giorni

allego esempio.
max

rollis13
00sabato 2 settembre 2017 23:49
Per il caso specifico che hai evidenziato il confronto in queste righe di codice: 
If intYears = 0 And intMonths = 0 And intDays > 1 Then
     GMA = intDays & " " & iG
va scritto così:
If intYears = 0 And intMonths = 0 And intDays >= 1 Then
     GMA = intDays & " " & iG
maxma62
00domenica 3 settembre 2017 08:50
Ciao rollis è O.K. [SM=g27811]
Ora in altri if else end if ci sono altri " > 1 " cambio anche in questi così " >=1 " ? 

ElseIf intYears = 0 And intMonths >= 1 And intDays = 0 Then
GMA = intMonths & " " & iM

ElseIf intYears >= 1 And intMonths = 0 And intDays = 0 Then
GMA = intYears & " " & iA



Una curiosità se voglio cambiare i riferimenti della funzione:
Public Function GMA(Date1 As Date, Date2 As Date) As String
nella macro: 

GMA = GMA_2    

If intYears = 0 And intMonths = 0 And intDays >= 1 Then
GMA_2 = intDays & " " & iG


ho provato ad aggiungere all'inizio:
Dim GMA_2 As String
ma non si visualizza niente.
Dove sbaglio?
max
dodo47
00domenica 3 settembre 2017 17:39
Ciao
a posto di quell'ambaradam, puoi fare così: 
Public Function GMA(Date1 As Date, Date2 As Date) As String
Dim intYears As Variant, intMonths As Variant, intDays As Variant
Dim iG As String, iM As String, iA As String
  intMonths = DateDiff("m", Date1, Date2)
  intDays = DateDiff("d", DateAdd("m", intMonths, Date1), Date2)
  If intDays < 0 Then
    intMonths = intMonths - 1
    intDays = DateDiff("d", DateAdd("m", intMonths, Date1), Date2)
  End If
  intYears = intMonths \ 12
  intMonths = intMonths Mod 12
  If intDays > 1 Or intDays = 0 Then iG = "giorni" Else iG = "giorno"
  If intMonths > 1 Or intMonths = 0 Then iM = "mesi" Else iM = "mese"
  If intYears > 1 Or intYears = 0 Then iA = "anni" Else iA = "anno"
  If intDays = 0 Then
    iG = ""
    intDays = ""
  End If
  If intMonths = 0 Then
    iM = ""
    intMonths = ""
  End If
  If intYears = 0 Then
    iA = ""
    intYears = ""
  End If
  GMA = intYears & " " & iA & " " & intMonths & " " & iM & " " & intDays & " " & iG
End Function


Nota che ho variato le dim di intYears intMonths intDays da integer a variant per potergli assegnare = "".

Non ho capito che vuoi quando dici: "...cambiare i riferimenti della funzione..."

saluti
maxma62
00domenica 3 settembre 2017 19:16
Ottimo dodo47,
ancora meglio. [SM=g27811]
Per il resto lasciamo tutto com'è.
Un saluto a tutti e grazie.
max
Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 03:23.
Copyright © 2000-2024 FFZ srl - www.freeforumzone.com