Quantcast
Channel: Visual Basic Tips and Tricks
Viewing all articles
Browse latest Browse all 2212

Conteggio festività, con metodi più o meno ordinari

$
0
0

Questa è una tardiva replica a una fervida discussione sul tema del conteggio festività in un dato periodo, in cui mesi or sono l'esimio Diego Cattaruzza diede informazioni ampie ed accurate.

Per comuni mortali & smemorati oso qui proporre come cavarsela col codice normale che ci passa il convento VB6/VBA.

Così  propongo due possibili soluzioni per conteggiare, in VB6/VBA, i giorni non lavorativi ossia includendo i sabati in un determinato periodo.  Nelle quali mi sono limitato alle festività canoniche e ho escluso

-  le feste patronali
- i periodi feriali

In quanto diversificate nei vari contesti (persino in un’azienda media ma articolata su sedi diverse), ritenendo che gli adattamenti particolari si possano sempre fare, non tanto sulla funzione base ma aggiungendo o togliendo qual che occorre caso per caso.

Un contributo aggiuntivo: calcolo della Pasqua. Ripropongo subito tale funzione senza commenti trattandosi di algoritmo empirico ma corretto:

Function DataDiPasqua(Anno As Integer) As Date

  Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer

  Dim Anni, M, Q

  Dim ind As Integer

  Anni = Array(1583, 1700, 1800, 1900, 2100, 2200, 2300, 2400)

  M = Array(22, 23, 23, 24, 24, 25, 26, 25)

  Q = Array(2, 3, 4, 5, 6, 0, 1, 1)

  ind = IndiceDove(Anno, Anni)

  a = Anno Mod 19

  b = Anno Mod 4

  c = Anno Mod 7

  d = (19 * a + M(ind)) Mod 30

  e = (2 * b + 4 * c + 6 * d + Q(ind)) Mod 7

  Dim didimar As Integer, MesePasq As Integer, GiorPasq As Integer

  didimar = 22 + d + e

  If didimar > 31 Then

    MesePasq = 4

    GiorPasq = didimar - 31

  Else

    MesePasq = 3

    GiorPasq = didimar

  End If

  DataDiPasqua = DateSerial(Anno, MesePasq, GiorPasq)

End Function

 

Function IndiceDove(Dato, Vettore) As Integer

  Dim i As Integer

  For i = UBound(Vettore) To 0 Step -1

    If Dato >= Vettore(i) Then Exit For

  Next

  IndiceDove = i

End Function

 

Prima soluzione. Per consentire una sperimentazione graduale si limita all’anno corrente 2015. Su un tal Modulo1 magari lo stesso contenente la funzione ... pasqualina il codice esordisce con una GiornoSett seguita da routine di prova:

Dim TabFeste() As Date ' Definizione a livello modulo

Function GiornoSett(Data As Date) As Integer

   d = (Data \ 7) * 7

   GiornoSett = Data - d

End Function

Sub NomeGiornoSett()

  Dim d As Date

  d = "10/5/2015"

  GioSett = GiornoSett(d)

  MsgBox GioSett

  MsgBox Choose(GiornoSett(d) + 1, "sab", "dom", "lun", "mar", "mer", "gio", "ven")

End Sub

La GiornoSett dà il resto della divisione per 7 di una certa Data e la Sub che segue rivela che i sabati e le domeniche corrispondono a GiornoSett = 1 e 0.

Ecco infine il sospirato codice:

Function NumFeste(Data1 As Date, Data2 As Date)

  Dim QuestaData As Date, GioSett As Integer

  For QuestaData = Data1 To Data2

    GioSett = GiornoSett(QuestaData)

    If GioSett = 0 Or GioSett = 1 Then

      ' GiornoSett = 0 o 1: Sabato o domenica

      NumFeste = NumFeste + 1

    End If

  Next

  For i = 0 To UBound(TabFeste)

    QuestaData = TabFeste(i)

    If QuestaData >= Data1 And QuestaData <= Data2 Then

      GioSett = GiornoSett(TabFeste(i))

        If GioSett = 0 Or GioSett = 1 Then

        NumFeste = NumFeste - 1 ' Sabato o Domenica già calcolati

      Else

        NumFeste = NumFeste + 1

      End If

    End If

  Next i

End Function

Si parte con una funzione NumFeste, di argomenti Data1 e Data2 dopo di che

- il primo loop For QuestaData = Data1 To Data2. . . Next somma tutti i sabati e domeniche nel periodo tra tali date:

- il secondo ciclo For i = 0 To UBound(TabFeste) . . . Next  toglie una festa a NumFeste se questa cade di sabato o domenica, altrimenti incrementa NumFeste.

La funzione NumFeste  agisce sulla matrice “comunitaria” TabFeste (definita a livello modulo, ricordate?) ma per essere operativa richiede una routine come questa DimmiFeste:

Sub DimmiFeste()

  ReDim TabFeste(8) ' Contiene le 8 feste canoniche

  TabFeste(0) = "1/1/2015"' Capodanno

  TabFeste(1) = "6/1/2015"' Epifania

  TabFeste(2) = DataDiPasqua(2015) + 1 ' Angelo 2015

  TabFeste(3) = "25/4/2015"' Liberazione

  TabFeste(4) = "1/5/2015"' Festa del lavoro

  TabFeste(5) = "2/6/2015"' Liberazione

  TabFeste(6) = "15/8/2015"' Ferragosto

  TabFeste(7) = "25/12/2015"' Natale

  TabFeste(8) = "26/12/2015"' S. Stefano

  Dim Msg As String

  Msg = "N. feste Apr./Mag. 2015:"

  MsgBox Msg  & vbLf & "       "& NumFeste ("1/4/2015", "31/5/2015")

End Sub

La sperimentazione, calendario alla mano, è lasciata al lettore, cui chiedo di fare un test su un foglio Excel come questo, nell’intervallo che parte in A1, ove la cella accanto a Giorni Tot fornisce la differenza fra Data2 e Data1 e quella del NumeroFeste contiene la formula =NumFeste(B1:B2) :

 

Data1

01/04/15

Data2

31/05/15

Giorni Tot.

60

NumeroFeste

19

Giorni lavor.

41

 

Di primo acchito si ottengono messaggi di errore #VALORE!.

Riflettendo, il motivo è subito visto: da sola, la NumFeste non può operare correttamente, richiedendo che la matrice TabFeste sia riempita con le festività del 2015. Agl’interessati il compito di una diversa impostazione, comunque faccio notare che, come nessuno o quasi si attende, lanciando la Sub DimmiFeste poi anche la cella del NumeroFeste restituisce il dato giusto!

Soluzione pluriennale. Su un altro modulo, come un Modulo2 si abbia il codice seguente:

Dim TabellaFeste() As Date

Function GiornoSettim(Data As Date) As Integer

   d = (Data \ 7) * 7

   GiornoSettim = Data - d

End Function

 

Function NumeroFeste(Data1 As Date, Data2 As Date)

  Dim QuestaData As Date, GioSett As Integer

  For QuestaData = Data1 To Data2

    GioSett = GiornoSettim(QuestaData)

    If GioSett = 0 Or GioSett = 1 Then

      ' GiornoSettim = 0  o 1 : Sabato o domenica

      NumeroFeste = NumeroFeste + 1

    End If

  Next

  For i = 0 To UBound(TabellaFeste)

    QuestaData = TabellaFeste(i)

    If QuestaData >= Data1 And QuestaData <= Data2 Then

      GioSett = GiornoSettim(TabellaFeste(i))

        If GioSett = 0 Or GioSett = 1 Then

        NumeroFeste = NumeroFeste - 1 ' Sabato o Domenica già calcolati

      Else

        NumeroFeste = NumeroFeste + 1

      End If

    End If

  Next i

End Function

Sub DimmiLeFeste()

  Dim Feste(7) ' Senza l'anno e Pasqua (mobile) esclusa

  Feste(0) = "1/1/"' Capodanno

  Feste(1) = "6/1/"' Epifania

  Feste(2) = "25/4/"' Liberazione

  Feste(3) = "1/5/"' Festa del lavoro

  Feste(4) = "2/6/"' Repubblica

  Feste(5) = "15/8/"' Ferragosto

  Feste(6) = "25/12/"' Natale

  Feste(7) = "26/12/"' S. Stefano

  ' TabellaFeste per 3 anni: 2015/2017

  Dim Anni(2) As Integer

  Anni(0) = 2015: Anni(1) = 2016: Anni(2) = 2017

  ReDim TabellaFeste(UBound(Feste) * 3 + 3) ' Inclusi i 3 Angelo

  k = 0

  For i = 0 To 2

    For j = 0 To UBound(Feste)

      TabellaFeste(k) = Feste(j) & Anni(i)

      k = k + 1

    Next

      TabellaFeste(k) = DataDiPasqua(Anni(i)) + 1 ' Aggiun

  Next

  ' Verifica TabellaFeste: tradurre i commenti in codice

 '  For i = 0 To UBound(TabellaFeste)

'    MsgBox TabellaFeste(i)

'   Next

  Dim Msg As String

  Msg = "N. feste Apr./Mag. 2015:"

  MsgBox Msg & vbLf & "       "& NumeroFeste("1/4/2015", "31/5/2015")

End Sub

Commenti tacitiani. La prima variante rispetto alla semplice NumFeste sta anzitutto in queste righe, che impostano gli anni dal 2015 al 2017, poi ridimensionano la TabellaFeste in conseguenza:

Dim Anni(2) As Integer

  Anni(0) = 2015: Anni(1) = 2016: Anni(2) = 2017

  ReDim TabellaFeste(UBound(Feste) * 3 + 3) ' Inclusi i 3 Angelo

Ma soprattutto la novità sta nelle righe iniziali che pongono nel vettore Feste la parte delle varie date prive dell’anno:

  Dim Feste(7) ' Senza l'anno e Pasqua (mobile) esclusa

  Feste(0) = "1/1/"' Capodanno

  Feste(1) = "6/1/"' Epifania

. . . .

  Feste(6) = "25/12/"' Natale

  Feste(7) = "26/12/"' S. Stefano

A questo punto, per pigrizia, affido all’esegesi fai-da-te il codice che aggiunge i vari 2015, 2016 e 2017 più i tre Angelo nella TabellaFeste triennale nonché tutto il resto.

RINGRAZIO ANTICIPATAMENTE quanti vorranno farmi critiche e segnalarmi non impossibili errori.

Viewing all articles
Browse latest Browse all 2212