Codice VBA per calcolo giorni

Question

Salve Forum

Chiedo, se possibile, un codice VBA che mi permetta di calcolare i giorni in aggiunta ad una data inizio, nel seguente modo:

Nella cella A2 Inserimento di una DataInizio;

Nella Cella B2 Inserimento del numero dei giorni 

La Cella C2 dovrà semplicemente rendere Il risultato della Somma di A2+B2

La Cella D2 dovrà invece operare due tipi di calcoli:

1) Se la data restituita dalla Cella C2 ricade in un giorno festivo (Domenica o festività Nazionali come da specchietto che segue)

01/01/2015	Capodanno
06/01/2015	Befana
06/04/2015	Pasquetta
25/04/2015	Liberazione
01/05/2015	Lavoro
02/06/2015	Repubblica
15/08/2015	Ferragosto
01/11/2015	Ognissanti
08/12/2015	Madonna
25/12/2015	Natale
26/12/2015	S.Stefano

la data da restituire dovrà essere differita al 1° giorno successivo lavorativo (i giorni lavorativi vanno da lunedì a Sabato);

Inoltre 2) La Cella D2 non deve conteggiare i giorni appartenenti al mese della sospensione feriale che è tutto Agosto, es.: se in A2 (DataInizio) trascriviamo  29/07/2015 e in B2 aggiungiamo 10 giorni, la Cella C2 dovrà restituire 08 Agosto 2015 mentre la Cella D2 dovrà restituire 08 Settembre 2015;

3. Se invece la DataInizio di cui alla cella A2 contiene una data di Agosto (es. 18/08/2015) e la Cella B2 contiene sempre giorni 10, la cella C2 dovrà restituire  28/08/2015 (A2+B2), mentre la Cella D2 dovrà restituire la data del 10/09/2015 (Inizio conteggio dal 1° Settembre).

Spero di essermi spiegato sufficientemente chiaro e, nel caso non lo fosse, sono ovviamente disponibile ad ulteriori chiarimenti.

Null'altro,

Saluti Paolo

Answer 1

Ciao Paolo,

[...]

Nel caso di una data di scadenza per la quale la differenza tra i numeri dei anni fosse maggiore di 1, o nel caso teoretico che il numero di giorni fosse negativo, la funzione restituirebbe  il valore # N/D (nella mia versione inglese #N/A);

A scanso di equivoci, la funzione è intrinsecamente anche in grado di gestire scadenze negative in cui la differenza di anni (come precedentemente definita) è inferiore a 2. Per utilmente impiegare la funzione per scadenze negative di più di 365 giorni, ma sempre soggetto a la limitazione di cui sopra, sarebbe necessario:

• Sostituire la tua formula del tipo:

= SE(A2 * B2> 0; ScadenzaDifferita (A2; B2); "")

con una formula del tipo:

= SE(****(A2 * B2)> 0; ScadenzaDifferita (A2; B2); "")

'--------->>

[EDIT] Purtroppo, utilizzando la funzione che corrisponde alla funzione inglese ABS (Absolute\Assoluto) io sono stato censurato, perché, in lingua inglese, il nome della funzione italiana è un asino (ciuco), ma è utilizzato anche in inglese americano (se non fosse un contradizione in termine!) come un equivalente volgare della parola italiana culo! A questo proposito vedi anche il thread:

**http://answers.microsoft.com/it-it/office/forum/office_2007-excel/formattazione-condizionale-formula-non-funziona/96baec6f-1f75-4b07-bef9-7514d5a86b6d**Comunque, se non fosse ormai chiaro, basta sostituire gli asterischi indesiderati con A  S S, senza gli spazi!

'<<---------

• nel codice della funzione ScadenzaDifferita, sostituisci

    Select Case Year(myDate) - Year(DataInizio)

    Case 0

        If Month(myDate) > 8 And Month(DataInizio) < 8 Then

            myDate = myDate + 31

        End If

    Case 1

        If Month(myDate) > 8 Then

            myDate = myDate + 31

        End If

    Case Is > 1, Is < 1

        myDate = CVErr(xlErrNA)

        GoTo XIT

    End Select

con:

Select Case Abs(Year(myDate) - Year(DataInizio)) <br><br>    Case 0 <br><br>        If Month(myDate) > 8 And Month(DataInizio) < 8 Then <br><br>            myDate = myDate + 31 <br><br>        End If <br><br>    Case 1 <br><br>        If Month(myDate) > 8 Then <br><br>            myDate = myDate + 31 <br><br>        End If <br><br>Case Is > 1 <br><br>        myDate = CVErr(xlErrNA) <br><br>        GoTo XIT <br><br>    End Select

Anche se il concetto di scadenze negative possa non essere utile per gli scopi attuali, io non avrei voluto 'sviarti' per quanto riguarda le potenziali capacità della funzione.

===

Regards,

Norman

Answer 2

Ciao Paolo,

Eccoti le risposte alle tue domande:

1) Le date inizio, nell'arco di un anno, spaziano dal 1° di Gennaio al 31 del mese di Dicembre;

2) il numero massimo di giorni che potrebbero  essere aggiunti alla DataInizio è al massimo di giorni 300.

Risposta succinta, utile e chiarissima!

Ho modificato la mia funzione per gestire le scadenze che non attraversano più di un anno, o meglio, dove la differenza nei numeri degli anni (ad esempio 2015, 2016, 2017) sia inferiore a 2.

Nel caso di una data di scadenza per la quale la differenza tra i numeri dei anni fosse maggiore di 1, o nel caso teoretico che il numero di giorni fosse negativo, la funzione restituirebbe  il valore # N/D (nella mia versione inglese #N/A);

Ho testato la funzione con tutte le date del tuo file Paolo20150922_SEI.xlsm e tutti i risultati ottenti sono stati in conformità con i valori stabiliti da te. Al fondo della tabella, ho aggiunto le date della tabella utilizzata nel file precedente P aolo20150922_CINQUE.xlsm. In relazione a queste date aggiunte, i risultati restituiti dalla nuova funzione sono stati anche loro in conformità con i valori previsti.

Suggerisco (ma non ho provato io) a concepire alcune date di prova potenzialmente problematiche; ad esempio tale da comprendere più domeniche e/o festività nazionali ecc.

I risultati che ho ottenuto sono mostrati nel seguente screenshot:

A proposito di questo screenshot:

• Ho nascosto le righe 10:150 per redurre le dimensioni dell'imagine;
• Le scadenze di più di un anno (come definito qui sopra) sono evidenziate in giallo;
• Le date aggiunte dal file precedente Paolo20150922_CINQUE.xlsm sono evidenziate in verde;
• La colonna G mostra le date previste da te;
• Nella cella H 2si trova la formula =SE(D2=G2,"","Problema!" ) che ho trascinato in basso e utilizzato per evidenziare eventuali risultati problematici.

Il codice della funzione diventa:

'==========>>

Option Explicit

'--------->>

Public Function ScadenzaDifferita(DataInizio As Date, _

                                  NumeroDiGiorni As Long) As Variant

    Dim myDate As Variant

    Dim Res As Variant, Res2 As Variant, Res3 As Variant

    Dim Nme As Name

    Dim v As Variant

    Dim i As Long

    Application.Volatile

    Set Nme = Application.Names("Ferie")

    v = Nme.RefersToRange

    For i = LBound(v) To UBound(v)

        v(i, 1) = CLng(v(i, 1))

    Next i

    If Month(DataInizio) = 8 Then

        DataInizio = DateValue("31 8" & " " & Year(DataInizio))

    End If

    myDate = DateAdd("d", NumeroDiGiorni, DataInizio)

    Select Case Year(myDate) - Year(DataInizio)

    Case 0

        If Month(myDate) > 8 And Month(DataInizio) < 8 Then

            myDate = myDate + 31

        End If

    Case 1

        If Month(myDate) > 8 Then

            myDate = myDate + 31

        End If

    Case Is > 1, Is < 1

        myDate = CVErr(xlErrNA)

        GoTo XIT

    End Select

    If Month(myDate) = 8 Then

        myDate = DateValue("31 8" & " " & Year(myDate)) + Day(myDate)

    End If

    Res = Application.Match(CLng(myDate), v, 0)

    If Not IsError(Res) Then

        myDate = myDate + 1

    End If

    Res2 = Application.Match(CLng(myDate), v, 0)

    If Not IsError(Res2) Then

        myDate = myDate + 1

    End If

    If Weekday(myDate, vbSunday) = vbSunday Then

        myDate = myDate + 1

    End If

    If Month(myDate) = 8 Then

        myDate = DateValue("31 8" & " " & Year(myDate)) + Day(myDate)

    End If

    Res3 = Application.Match(CLng(myDate), v, 0)

    If Not IsError(Res3) Then

        myDate = myDate + 1

    End If

    If Weekday(myDate, vbSunday) = vbSunday Then

        myDate = myDate + 1

    End If

XIT:

    ScadenzaDifferita = myDate

End Function

'<<=========

Ho caricato il file Paolo20150922_SETTE.xlsm a:

                          http://1drv.ms/1QDTxDp

Come ho avuto bisogno di dire in altre occasioni, se il mio orrendo italiano - e l'ora :-)) -hanno cospirato per rendere la mia spiegazione altro che ottimalmente chiara, ti prego di perdonarmi e di chiedere pure ulteriori chiarimenti.

A domenica.

===

Regards,

Norman

Answer 3

Ciao Paolo,

Ho scaricato il tuo file e vedevo:

Essendo fiducioso che la mia UDF funziona correttamente, ho premuto Alt+Ctrl+F9 per effettuare una recalcolazione di tutte le formula e, un millisecondo dopo, vedo invece:

Mi pare che, in questo modo, tutte le tue formule restituiscano i risultati voluti.

Detto questo, noto che hai usato l'intervallo A2:A20 , anzichè il mio intervallo di A2:A13, sul foglio DatePaolo per definire il nome Ferie. L'inclusione in questo intervallo di celle vuote potrebbe provocare problemi e questo dovrebbe essere evitato. Se, e quando, si aggiungono o si eliminano eventuali festività nazionali, modifica la definizione utilizzata per il nome Ferie. In alternativa, definisci Ferie come un range dinamico.

Inoltre. per aiutare il ricalcolo di queste formule, nel codice della mia UDF, sostituisci la riga

    Set Nme = Application.Names("Ferie")

con:

Application.Volatile

    Set Nme = Application.Names("Ferie")

===

Regards,

Norman

Answer 4

Ciao Norman

Ho sdoppiato il tuo file di esempio e, per distinguerlo dal tuo originale, l'ho ridenominato così: Paolo20150922_BIS e si trova posto in OneDrive all'indirizzo che segue:

 https://onedrive.live.com/?id=A35E0B80441FC6B5%21125&cid=A35E0B80441FC6B5&group=0

Detto ciò, come potrai vedere dal mio file, ho inserito un 2° Foglio in cui ho immesso dei dati che però non so se servono per il prosieguo della realizzazione di questo File (vedi tu se eliminare qualcosa che non serve).

Come potrai notare nel Foglio "DatePaolo", nelle Celle D4:D9 dà come risultato #VALORE! evidentemente il Codice ancora non calcola la sospensione feriale dall'1/8 al 31/8 che, ti ricordo, non va conteggiato (è come se non esistesse), se DataInizio è in Luglio, si contano i giorni di Luglio sino al 31 per poi continuare il conteggio ripartendo dal 1° Settembre (come da esempi che vedrai). Ovviamente qualsiasi DataInizio che decorre da Agosto, per il suo conteggio dei giorni si inizia direttamente dal 1° giorno di Settembre (come da esempi che ti ho fatto e che troverai nel Foglio "DatePaolo" nella Colonna "E").

Le risultanze delle celle della Colonna "C" sono ovviamente tutte corrette e vengono calcolate così come avevo richiesto.

Saluti ed a dopo, grazie per il tuo interessamento, Ciao Paolo

Answer 5

Ciao Paolo, 

Crea il nome Ferie per riferire alla prima colonna di una tabella delle festività Nazionali. Questa tabella può essere sul foglio di interesse, o su un altro foglio - eventualmente anche un foglio nascosto:

Poi prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'==========>>

Option Explicit

'--------->>

Public Function DataPaolo(DataInizio As Date, _

                          NumeroDiGiorni As Long) As Date

    Dim myDate As Date

    Dim Res As Variant, Res2 As Variant

    Dim Nme As Name

    Dim v As Variant

    Dim i As Long

    Set Nme = Application.Names("Ferie")

    v = Nme.RefersToRange

    For i = LBound(v) To UBound(v)

        v(i, 1) = CLng(v(i, 1))

    Next i

    If Month(DataInizio) = 8 Then

        DataInizio = DateValue("31 august")

    End If

    myDate = DateAdd("d", NumeroDiGiorni, DataInizio)

    If Month(myDate) = 8 Then

        myDate = DateValue("31 August") + Day(myDate)

    End If

    Res = Application.Match(CLng(myDate), v, 0)

    If Not IsError(Res) Then

        myDate = myDate + 1

    End If

    Res2 = Application.Match(CLng(myDate), v, 0)

    If Not IsError(Res2) Then

        myDate = myDate + 1

    End If

    If Weekday(myDate, vbSunday) = vbSunday Then

        myDate = myDate + 1

    End If

    DataPaolo = myDate

End Function

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel.
• Salva il fil con l'estensione xlsm

Per l''esempio nello screenshot qui sopra, la formula immessa in D2. e trascinata in basso, era: =DataPaolo(A2,B2)

Potresti scaricare il mio file di prova Paolo20150922.xlsm a:

                    **http://1drv.ms/1NIwNTq**

===

Regards,

Norman