Ti suggerisco di usare la funzione TerminaXa, descritta in questa vecchia discussione:
viewtopic.php?f=26&t=98657&p=582449#p582449Presuppone la presenza di una tabella che descrive gli orari lavorativi, descritta nel messaggio che ho linkato.
Il codice della funzione:
- Codice: Seleziona tutto
Function TermineXA(ByVal Durata As Double, ByVal Via As Double, ByRef TT As Range, _
Optional ByRef Holid As Range, Optional ByRef AllTable As Range) As Variant
'V 3.0 B31221 by Anthony
'Data una "durata" in [hh]:mm:ss, una data/ora di inizio, e un orario di lavoro,
' calcola la data/ora di conclusione (di una attivita')
'L' orario e' definito separatamente per i giorni settimanali: 1=Lun, 2= Mart,... 7=Dom
' la tabella orari e' organizzata come segue
' 1 6 7 10 '1="dal Lunedì in avanti"; 6="dal Sab in avanti"; ... 10=Festivi
' Entr Entr Entr Entr
' Usc Usc Usc Usc
' Entr Entr Entr Entr
' Usc Usc Usc Usc
' ... ... ... ...
'MAX 10 blocchi Entr/Usc; se blocco vuoto=non si lavora
'
'Esempio di Uso:
' =TermineXA(OreDurataTask;DataOraDiInizio;IntestazioneTabellaOrari;RangeFestivita'[;Opzionale:TabellaOrari])
' Ore e Date vanno indicate come Ore e Date nel formato Excel
'
Dim CDay As Long, mWTT, CDTT As Range, I As Long, MinMatch, RowSt As Long, MinTask As Long, MinScr As Long
Dim EndMin As Double, J As Long, CDTRec As Long, CDStart As Double
'
Const MaDay As Long = 24 * 60
MinTask = Durata * MaDay
If MinTask > (500 * 60) Then TermineXA = CVErr(xlErrNA): Exit Function
'
'Gestisci Holid opzionale:
If Holid Is Nothing Then
Set Holid = TT
End If
'
For J = 1 To 200
CDay = Application.WorksheetFunction.Weekday(Via, 2)
If Application.WorksheetFunction.CountIf(Holid, Int(Via)) > 0 Then CDay = 10 'caso festivo
mWTT = Application.Match(CDay, TT, True)
Set CDTT = Range(TT.Cells(1, mWTT).Offset(1, 0), TT.Cells(1, mWTT).End(xlDown)) 'current day timetable
If CDTT.Rows.Count <= 20 Then
CDTRec = Application.WorksheetFunction.CountA(CDTT)
CDStart = (CDTT.Cells(1, 1).Value * MaDay)
For I = (Via - Int(Via)) * MaDay To MaDay
If I >= CDStart Then
MinMatch = Application.Match(I / MaDay, CDTT, True)
If MinMatch Mod 2 = 1 Then
MinScr = MinScr + 1
Else
If MinMatch >= CDTRec Then Exit For
End If
If MinScr >= MinTask Then
EndMin = (I + 1) / MaDay
GoTo EndF
End If
End If
Next I
End If
Via = Int(Via) + 1
Next J
'
EndF:
TermineXA = Int(Via) + EndMin
'max circa 200 gg
If J >= 200 Then
TermineXA = CVErr(xlErrNA)
End If
End Function
Poi calcolerai data /ora di termine di un task con una formula del tipo
- Codice: Seleziona tutto
=TermineXA(OreDurataTask;DataOraDiInizio;IntestazioneTabellaOrari[;RangeFestivita'[;Opzionale:TabellaOrari]])
I parametri tra parentesi quadre sono opzionali.
Fai sapere…
Registrazione
