Ne' si puo' dare per scontato che "Notturno" sia per tutti quello che comincia alle 22:00 e finisce alle 6:00 (per fare un esempio).
Stanco di rispondere a domande e classificazioni che sfidano la logica (e la pazienza), anni fa avevo sviluppato la funzione programmabile XSTRA, poi evoluta in XSTRA2 e infine (versione corrente) XSTRA3
Questa si basa su una tabella in cui l'utente dichiara come vanno interpretati gli straordinari effettuati in fasce di orario assolutamente arbitrarie.
I casi considerai sono i 7 gg della settimana, il "prefestivo", il "festivo infrasettimanale", il "festivo seguito da festivo" (quindi 10 casi in tutto)
Il tracciato dei dati prevede:
Una colonna "Data" con adiacente (a destra) l'indicazione di eventuale Festivo (da prelevare da una tabella di giorni Festivi); quattro colonne con due coppie di Entrata/Uscita; puo' essere compilata solo una coppia.
In altra posizione va impostata una tabella che dichiara, per ognuno dei 10 casi prima descritti, l'orario di lavoro standard e poi una serie di fasce orario con la corrispondente tipologia da assegnare agli straordinari effettuati in quella fascia.
Se invece si vuole suddividere anche l'orario lavorativo (non le ore extra) allora basta che nella tabella descrittiva l'orario di lavoro standard sia dichiarato pari a 00:00
Sono previsti fino a 16 "tipi" diversi.
La macro restituira' una matrice di 16 valori, di cui il primo significa "orario totale lavorato" e i successivi indicano l'orario di "tipo 1", l'orario di "tipo 2" e cosi' via.
La funzione XSTRA3 va richiamata con questa sintassi:
- Codice: Seleziona tutto
=XSTRA3(CellaData; AreaTimbrature; AreaTabellaDichiarazioni)
- Codice: Seleziona tutto
=Xstra3($A3;$C3:$F3;Supporto!$A$1:$I$11)
Inserita in forma di matrice su N colonne restituira' il TotaleLavorato, totale di Tipo1, di Tipo2, di Tipo3,... di Tipo(N-1)
Poiche' il cuore di tutto e' la tabella delle dichiarazioni e' utile qualche spiegazione.
Si veda questo esempio (arbitrario) di dichiarazioni:
(l'immagine e' anche "allegata", visibile in findo al testo)
La tabella si estende da A1 a I11 (l'altezza e' fissa, la larghezza puo' essere a piacere)
Accanto all'ultima colonna usata deve essercene una vuota (J, nell'esempio)
La prima riga contiene le intestazioni; le altre righe corrispondono ai 10 casi descritti all'inizio.
La cella iniziale (A1 nell'esempio) deve contenere la stringa DefOrari
La seconda colonna indica l'orario standard per quel caso.
Le altre colonne devono indicare un orario che parte dalle 0:00 del giorno in esame e arriva alle ore 24:00 del giorno successivo (nella pratica dovrebbe bastare arrivare alle 12:00 del giorno dopo, ma arrivando fino alle 24:00 si dovrebbero coprire anche casi di stackanovisti all'ultimo stadio).
Per quanto appena detto, la seconda parte della tabella del giorno X in linea di massima corrispondera' alla prima parte del giorno X+1, con le dovute "deviazioni"
Il codice sotto la colonna dell'orario 00:00 non e' significativa (non ci puo' essere straordinario "fino alle ora 0:00).
Il codice sotto le colonne degli altri orari indicano come verra' catalogato un eventuale straordinario che venisse effettuato "fino a quell'orario". Ad esempio 1 in E2 dice che lo straordinario effettuato dopo le 6 di un lunedi' non festivo sara' catalogato come "tipo 1", mentre dalle 20 alle 6 del giorno dopo sara' di "tipo 2"
In colonna K c'e' la legenda che indica a quale caso si riferisce quella riga.
Un commento sulle timbrature: le uscite fatte a un orario inferiore all'entrata si intendono relative al "giorno successivo"; es se sulla riga del 4 feb si indica E=22:00, U=6:00 si intende che l'uscita sara' alle 6 del 5 feb.
Il codice della funzione XSTRA3:
- Codice: Seleziona tutto
Function Xstra3(ByRef Data As Range, ByRef cInOuTable As Range, ByRef cDefOrario As Range, Optional ByVal TipoXstra As Long = 0, Optional TotH) As Variant
'Data=cella contenente la data; cInOuTable=le 4 timbrature (E-U, E-U)
'cDefOrario=indirizzo tabella con la matrice gg/hh/tipo di straordinario
'SUPERATO TipoXstra= valore del "tipo" richiesto; oppure 0=Ore lavorate
'
Dim GSett As Integer
Dim In1 As Single: Dim In2 As Single: Dim CTy As Single
Dim Out1 As Single: Dim Out2 As Single
Dim WHours As Single
Dim DefCols As Long, I As Long, CT As Long
Dim TabTy(16) As Single: Dim TabTy0 As Single: Dim TabTyOld As Single
'Varianti per A
Dim DOArr(), InOuTable As Range, DefOrario As Range
Dim TIMBR
Dim I1 As Long
'==
Set DefOrario = cDefOrario.Range("A1")
If DefOrario <> "DefOrari" Then Exit Function
''Application.Volatile
'aaaa = Data
GSett = Weekday(Data, vbMonday)
'
If GSett < 6 Then
If Data.Offset(0, 1) = 1 Then
GSett = (9 + Data.Offset(1, 1))
Else
If Data.Offset(1, 1) = 1 Then GSett = 8
End If
End If
If Weekday(Data, vbMonday) = 6 Then
If Data.Offset(0, 1) = 1 Then
GSett = 10
Else
GSett = 6
End If
End If
If Weekday(Data, vbMonday) = 7 Then
If Data.Offset(1, 1) = 1 Then GSett = 10
End If
'
Set InOuTable = cInOuTable.Range("A1")
In1 = InOuTable
Out1 = InOuTable.Offset(0, 1).Value + (InOuTable.Offset(0, 1) < In1) * -1
If InOuTable.Offset(0, 2).Value = 0 Then In2 = Out1 Else: In2 = InOuTable.Offset(0, 2).Value + (InOuTable.Offset(0, 2) < Out1) * -1
If InOuTable.Offset(0, 3).Value = 0 Then Out2 = In2 Else Out2 = InOuTable.Offset(0, 3).Value + (InOuTable.Offset(0, 3).Value < In2) * -1
'
DefCols = DefOrario.End(xlToRight).Column - DefOrario.Column
'
WHours = Out2 - In2 + Out1 - In1
TabTy(0) = WHours
ReDim DOArr(0 To 10, 0 To DefCols)
DOArr = DefOrario.Range("A1").Resize(10 + 1, DefCols + 1).Value
Xstra3 = WHours - DOArr(GSett + 1, 2)
If Xstra3 <= 0.0001 Then '<= 9 sec
Xstra3 = TabTy: Exit Function
End If
For I = DefCols To 2 Step -1
''A If Out2 > DefOrario.Offset(0, I) Then Exit For
If Out2 > DOArr(1, I + 1) Then Exit For
Next I
CalcTy:
''A CT = DefOrario.Offset(GSett, I + 1)
CT = DOArr(GSett + 1, I + 2) ' DefOrario.Offset(GSett, I + 1)
I1 = I + 1
TabTy0 = Out2 - DOArr(1, I1) 'DefOrario.Offset(0, I)
If In2 >= DOArr(1, I1) Then TabTy0 = TabTy0 + DOArr(1, I1) - In2
If Out1 >= DOArr(1, I1) Then TabTy0 = TabTy0 + Out1 - DOArr(1, I1)
If In1 >= DOArr(1, I1) Then TabTy0 = TabTy0 + DOArr(1, I1) - In1
TabTy0 = TabTy0 - TabTyOld
TabTy(CT) = TabTy0 + TabTy(CT)
TabTyOld = TabTyOld + TabTy0
Xstra3 = Xstra3 - TabTy0
If Xstra3 <= 0.00001 Then
TabTy(CT) = TabTy(CT) + Xstra3
''3
Xstra3 = TabTy 'TabTy(TipoXstra + 1)
Exit Function
End If
I = I - 1
If I > 1 Then GoTo CalcTy
Xstra3 = "XXX" 'Errore, I=<2 e non ancora completato il calcolo
End Function
Un file dimostrativo e' scaricabile qui: https://www.dropbox.com/s/9xddqx7vxyo5j ... .xlsm?dl=0
Spero che quanto descritto possa essere di qualche utilita'.
Vi rimando anche a vecchie discussioni su questo tema, immagino che le spiegazioni gia' date in passato possano essere utili anche per chi ha bisogno di cimentarsi oggi:
viewtopic.php?f=26&t=69705
viewtopic.php?f=26&t=66808
viewtopic.php?f=26&t=67341
viewtopic.php?f=26&t=74698
viewtopic.php?t=97956
viewtopic.php?t=99106
Tuttavia vi prego di inserire qui i vostri messaggi relativi a quanto qui presentato, che rappresenta l'aggiornamento delle discussioni precedenti
Ciao a tutti.
