Codice conta ore

Hai un problema con Excel?

Nuova discussione

Codice conta ore
di Marcel (utente non iscritto) data: 04/04/2014 08:14:37
Buongiorno a tutti, di seguito un codice VBA che sinceramente non è farina del mio sacco, funziona in maniera egreggia, tuttavia le mie necessita' sono variate e avrei bisogno che il codice consideri il sabato come gli altri giorni (cosa che attualmente fà) ma con range d'orari differente.
E' possibile inserire questa eccezzione?

Grazie mille a chi potrà essermi d'aiuto!

Function CalcolaMinuti(Inizio As Date, fine As Date) As Long
Dim dateStart As Date, dateStop As Date, minutiTot As Long, actDate As Date
Dim Giorno_Inizio As Date
Dim Giorno_Inizio_Cor As Date
Dim Giorno_Fine As Date
Dim Giorno_Fine_Cor As Date

minutiTot = 0
dateStop = Format(fine, "dd/mm/yyyy")
actDate = Format(Inizio, "dd/mm/yyyy")


Do Until actDate > dateStop
    'ad ogni iterazione verifica se festivo
    If Weekday(actDate, vbMonday) > 6 Or Festivo(actDate) Then
    Else
        'imposto variabili giorno corrente
        Giorno_Inizio_Cor = CDate(Format(actDate, "dd/mm/yyyy") & " 07.00.00")
        Giorno_Fine_Cor = CDate(Format(actDate, "dd/mm/yyyy") & " 20.00.00")
        'determino giorno inizio
        If Giorno_Inizio_Cor >= Inizio And Giorno_Inizio_Cor <= fine Then
            Giorno_Inizio = Giorno_Inizio_Cor
        ElseIf Giorno_Inizio_Cor < Inizio Then
            Giorno_Inizio = Inizio
        ElseIf Giorno_Inizio_Cor > fine Then
            'salta passaggio
            GoTo successivo
        End If
               
        'determino giorno Fine
        If Giorno_Fine_Cor >= Inizio And Giorno_Fine_Cor <= fine Then
            Giorno_Fine = Giorno_Fine_Cor
        ElseIf Giorno_Fine_Cor >= fine Then
            Giorno_Fine = fine
        ElseIf Giorno_Fine_Cor <= Inizio Then
            'salta passaggio
            GoTo successivo
        End If
        

        'eseguo il calcolo
        minutiTot = minutiTot + DateDiff("n", Giorno_Inizio, Giorno_Fine)
    End If
    
    'giorno successivo
successivo:
    actDate = DateAdd("d", 1, actDate)
Loop


'risultato
CalcolaMinuti = minutiTot
End Function

di Vecchio Frac data: 04/04/2014 09:26:13
Un piccolo esempio pratico con dati in ingresso e risultato atteso?
di marcel (utente non iscritto) data: 04/04/2014 09:36:48
Esempio pratico:
Inizio lavoro il 04/04/2014 9.30, fine lavoro il 07/04/14 ore 9.30, sono 4320 minuti totali (qui interviene il codice attuale) sottrae la domenica e le ore notturne e mi restituisce 1560 minuti.
Ho però una nuova variante cioè il sabato lavorativo, che ha orari differenti (7.00 / 13.00) e quindi mi attendo un risultato di 1140 minuti.
Spero di essere stato chiaro.
Grazie
di Grograman (utente non iscritto) data: 04/04/2014 09:49:11
No lui con "esempio pratico" intende il file con i dati, il tuo è un esempio teorico
di marcel (utente non iscritto) data: 04/04/2014 10:03:17
Ho il file su dropbox ma il forum mi blocca nel postare il link, come posso fornirvi il file?
di Vecchio Frac data: 04/04/2014 10:12:20
cit. "il forum mi blocca nel postare il link"
---> scrivi il link senza protocollo iniziale, cioè senza "ww w" e senza "ht tp".

Comunque lascia stare forse riusciamo a ricostruire un pezzo di scenario.
di marcel (utente non iscritto) data: 04/04/2014 10:14:34
htt ps://w ww.dropbox.com/s/zmn9myiyetczyyp/Cartel1.xlsm

eccolo in caso serva!
di Vecchio Frac data: 04/04/2014 10:26:11
Grazie.
Comunque stavo ragionando anche sulla comoda funzione =GIORNI.LAVORATIVI.TOT() che dovrebbe effettuare il calcolo dei giorni lavorativi compresi tra due date e che, come terzo argomento, accetta una tabella di festività da escludere nel calcolo.
Quindi tutta la tua macro potrebbe essere sostituita da quest'unica funzione.
Se devi comprendere anche i sabati lavorativi il ciclo si può ridurre a spazzolare il range di inizio e fine, considerando solo i sabati.
Potrebbe andare come ragionamento alternativo?
di Vecchio Frac data: 04/04/2014 10:29:42
Ah un'altra cosa.
DateDiff("n", data1, data2) restituisce la differenza in minuti tra due date.
Quindi invece che scorrere tra le due date e aggiungere i minuti calcolati giorno per giorno, in un'unica operazione ottieni i minuti tra due date. A cui poi devi sottrarre il calcolo dei giorni festivi (e qui interviene la funzione GIORNI.LAVORATIVI.TOT).
di marcel (utente non iscritto) data: 04/04/2014 10:32:25
Uhm, diciamo che non ho capito benissimo il consiglio, nello specifico con la funzione che riporti mi conteggia i giorni lavorativi in ore, ma non potrei dargli un range di orari da escludere o sbaglio?
di marcel87 (utente non iscritto) data: 04/04/2014 10:36:05
per il momento avrei risolto nel file che ho postato su dropbox, cambiando la formula nella casella C1 con la seguente =CalcolaMinuti(A2;B2)-CalcolaMinutiSabato(A2;B2) .
Però mi sembra una cosa poco attendibile o comunque più posticcia!

di Vecchio Frac data: 04/04/2014 10:39:51
Intanto correggi come segue, che tiene conto del nuovo vincolo sul sabato lavorativo.
Poi vedo se riesco a migliorare il codice (mi piacciono poco quei goto...)

Option Explicit

Function CalcolaMinuti(Inizio As Date, fine As Date) As Long
Dim dateStart As Date, dateStop As Date, minutiTot As Long, actDate As Date
Dim Giorno_Inizio As Date
Dim Giorno_Inizio_Cor As Date
Dim Giorno_Fine As Date
Dim Giorno_Fine_Cor As Date

minutiTot = 0
dateStop = Format(fine, "dd/mm/yyyy")
actDate = Format(Inizio, "dd/mm/yyyy")

Do Until actDate > dateStop
    'ad ogni iterazione verifica se festivo
    If Weekday(actDate, vbMonday) <= 6 And Not Festivo(actDate) Then
        'imposto variabili giorno corrente
        Giorno_Inizio_Cor = CDate(Format(actDate, "dd/mm/yyyy") & " 07.00.00")
        
        If Weekday(actDate, vbMonday) <> 6 Then
            Giorno_Fine_Cor = CDate(Format(actDate, "dd/mm/yyyy") & " 20.00.00")
        Else
            Giorno_Fine_Cor = CDate(Format(actDate, "dd/mm/yyyy") & " 13.00.00")
        End If
        'determino giorno inizio
        If Giorno_Inizio_Cor >= Inizio And Giorno_Inizio_Cor <= fine Then
            Giorno_Inizio = Giorno_Inizio_Cor
        ElseIf Giorno_Inizio_Cor < Inizio Then
            Giorno_Inizio = Inizio
        ElseIf Giorno_Inizio_Cor > fine Then
            'salta passaggio
            GoTo successivo
        End If
               
        'determino giorno Fine
        If Giorno_Fine_Cor >= Inizio And Giorno_Fine_Cor <= fine Then
            Giorno_Fine = Giorno_Fine_Cor
        ElseIf Giorno_Fine_Cor >= fine Then
            Giorno_Fine = fine
        ElseIf Giorno_Fine_Cor <= Inizio Then
            'salta passaggio
            GoTo successivo
        End If

        'eseguo il calcolo
        minutiTot = minutiTot + DateDiff("n", Giorno_Inizio, Giorno_Fine)
    End If
    
    'giorno successivo
successivo:
    actDate = DateAdd("d", 1, actDate)
Loop


'risultato
CalcolaMinuti = minutiTot
End Function

di Vecchio Frac data: 04/04/2014 10:41:19
Non avevo visto il tuo intervento, anche se ho visto il file e sì, la cosa è arzigogolata :)
La modifica è facile, perchè basta inserire il vincolo uovo nel valore da dare a "Giorno_Fine_Cor".
Vedi modifica al codice.

p.s. ricordati di impostare sempre Option Explicit in testa ai tuoi moduli.

di Vecchio Frac data: 04/04/2014 11:15:29
Ho rielaborato il codice come segue ma serve qualche test per la verifica.
Copiaincolla in un modulo e fai qualche prova con dati certi per vedere se i risultati sono congruenti con quello che ti aspetti.
Eventualmente ne riparliamo (però se aggiungevi qualche altra riga nel file con dati di esempio era meglio ^_^).

Function CalcolaMinuti_vfrac(inizio As Date, fine As Date) As Long
Dim d As Long, diff As Long, giorni_feriali  As Long, ore_giorni_feriali  As Long, ore_sabato As Long
Dim QUOTE As String

    QUOTE = Chr(34)
    
    'escludo il giorno finale del periodo
    fine = DateAdd("d", -1, fine)
    
    'calcolo i giorni feriali nel periodo
    giorni_feriali = Evaluate("GIORNI.LAVORATIVI.TOT(" & QUOTE & inizio & QUOTE & "," & QUOTE & fine & QUOTE & ")")
    
    'e le ore corrispondenti
    ore_giorni_feriali = giorni_feriali * 13
    
    'calcolo quanti sabati ci sono nel periodo e le ore corrispondenti
    ore_sabato = quanti_sabato(inizio, fine) * 6
    
    'eseguo il calcolo
    CalcolaMinuti_vfrac = (ore_giorni_feriali + ore_sabato) * 60

End Function

Private Function quanti_sabato(inizio As Date, fine As Date)
Dim c_date As Date, i As Long

    For c_date = inizio To fine
        If Weekday(c_date, vbMonday) = vbSaturday Then i = i + 1
    Next
    quanti_sabato = i
End Function

di Vecchio Frac data: 04/04/2014 11:22:01
Nota bene che quanto ho scritto *non* tiene conto dei festivi, per cui attualmente devi considerare solo se è valido l'approccio.
Tra parentesi anche la Function Festivo() si può migliorare e compattare.
E come dici tu nei tuoi commenti considera la possibilità di una tabella separata per i festivi; ricorda che GIORNI.LAVORATIVI.TOT ne tiene conto senza codice aggiuntivo, basterebbe costruire la tabella delle festività... Lunedì dell'Angelo a parte che è variabile e va calcolato a parte come hai fatto.
di marcel (utente non iscritto) data: 04/04/2014 11:30:20
Mi stò un pò perdendo..
Stavo testando quella precedente e sembra funzionare, ora verifico la seconda che hai inviato!
P.s. come mai si è persa la funzione dei festivi?
Non mi basta reinserire la porzione del vecchio codice?

Ti chiedo inoltre, se volessi il risultato in unità orarie e non in minuti cosa devo fare?

Grazie 1000 sei molto gentile!!
di Vecchio Frac data: 04/04/2014 12:01:30
Non perderti... leggi un post alla volta ^_^
La funzione dei festivi non si è persa... non l'ho proprio considerata :)
Il risultato in unità orarie?
secondo te cosa fa il codice seguente:
CalcolaMinuti_vfrac = (ore_giorni_feriali + ore_sabato) * 60
...? ^_^
(togli il * 60 e avrai il calcolo in ore... se moltiplichi ore per 60 ottieni minuti)
di marcel (utente non iscritto) data: 04/04/2014 12:46:29
Nel test che sto effettuando noto che se vengono inseriti orari di fine lavoro fuori dai range impostati non mi considera nemmeno le ore che fanno parte del range.
esempio
4/1/14 13.30 4/1/14 17.10
di Vecchio Frac data: 04/04/2014 13:39:38
Il secondo codice postato tiene conto solo delle giornate intere.
Non calcola le frazioni di ora.
Ma non mi pare lo facesse nemmeno con la tua versione.
Comunque prepara qualche riga con dati da testare, con il risultato atteso, e poi effettuiamo la taratura del codice.
di marcel (utente non iscritto) data: 07/04/2014 07:39:54
Scusate per l'assenza!
Ho preferito prendermi una pausa perchè stavo fondendo.. :P
Allora vi fornisco un file con dati reali, che contiene anche dati non sempre veritieri perchè vengono compilati da più persone.
Per ora fa' piu' o meno tutto quello che mi ero prefissato facesse, tuttavia il secondo codice Vba non sono riuscito a capire come farlo funzionare!

h ttps://w ww.dropbox.com/s/vx8pd9z8lgcrgla/PROCESSO.xlsm

Vuoi Approfondire?