Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Confronto data orario con altra data orario

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Confronto data orario con altra data orario

Postdi SaturnoGio » 14/07/18 12:18

Ciao a tutti questo è il mio primo post, di norma ci si deve presentare ma non ho trovato niente a riguardo oppure non ho cercato bene, forse non ho trovato un titolo troppo adatto.

Uso Excel 2013, con le formule non me la cavo molto bene se non per le basi, invece con il vba riesco a cavarmela mediamente

scorrendo il forum ho visto che riuscite a risolvere molti problemi riguardo Excel, in tal proposito ho un problema che sono giorni che non riesco a risolvere.

la materia più ostica di Excel date ed orari.
ho del personale che lavora in più cantieri, a volte lo stesso, ed hanno un orario di entrata ed uno di uscita, non ci sono pause pranzo.

il mio problema che dovrei riuscire ad evidenziare con messaggi se ci sono accavallamenti di presenze, cioè la stessa persona non può nello stesso giorno lavorato nello stesso cantiere o altro cantiere con orari accavallati, cioè presente nello stesso momento in posti uguali o diversi, esempio

il 25/6/18 giovanni ha lavorato al cantiere1 entrato alle 12,30 ed uscito alle 15.50
il 25/6/18 giovanni ha lavorato al cantiere2 entrato alle 10.50 ad uscito alle 14.20

altri orari vanno oltre le 24 superano la mezzanotte per l'uscita

come si vede ce un accavallamento di orario nelle presenze dalle 12,30 alle 14,20

per finire di complicare le cose la persona che riporta l'entrata e le uscite scrive gli orari come decimali non in formato orario, cioè 12virgola30.

sono riuscito con il vba anche se a parer mio non funziona troppo bene, alcune volte non da l'orario giusto ma non capisco perche, non sono riuscito a trovare la conversione giusta, ma in linea di max funziona, trasformare 12,30 i orario 12:30.

ora inserendo un nuovo orario, con l'evento "Change" parte la macro che controlla tutti i precedenti orari con l'attuale inserito se ci sono accavallamenti di ore, e questo non riesco a farlo evidenziare se non in parte, perche controllando alcuni orari non li evidenzia

Questo un esempio orari in giallo il secondo giallo ha un orario accavallato

Immagineimmagin

allego anche il file con le macro che ho usato

il problema è questo confronto con le date che non riesco ad ottenere

Codice: Seleziona tutto
            If da4 >= ka4 And da5 <= ka5 Then 'And da4 <= ka5 Then
                Cells(rr, 7) = m1
                k = 1
            End If


il file

http://www.filedropper.com/provapresenze2

Ciao jSat
Avatar utente
SaturnoGio
Newbie
 
Post: 3
Iscritto il: 14/07/18 10:16

Sponsor
 

Re: Confronto data orario con altra data orario

Postdi Anthony47 » 16/07/18 01:20

Per il controllo potresti usare questa macro:
Codice: Seleziona tutto
Sub IspezionOrari()
Dim FreeC As String, I As Long, J As Long, LastA As Long
Dim cWo As String, cDa, iOut As Single, jOut As Single
'
FreeC = "O"         '<<< Una colonna Libera
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
Cells(3, FreeC).Resize(LastA, 1).ClearContents
For I = 3 To LastA
    If Cells(I, 3) <> "" Then
        cWo = Cells(I, 3)
        cDa = Cells(I, 1)
        iOut = Cells(I, 5): If iOut < Cells(I, 4) Then iOut = iOut + 24
       
        For J = 3 To I - 1
            If Cells(J, 3) = cWo And Cells(J, 1) = cDa Then
                jOut = Cells(J, 5): If jOut < Cells(J, 4) Then jOut = jOut + 24
                If Cells(I, 4) >= Cells(J, 4) And iOut <= jOut Then
                    Cells(I, FreeC) = Cells(I, FreeC) & J & ", "
'                    Exit For
                End If
            End If
        Next J
    End If
Next I
MsgBox ("Controllo completato...")
End Sub
Va messa in un Modulo standard del vba; la riga marcata <<< va personalizzata come da commento

Lanciando poi la Sub IspezionOrari nella colonna libera che hai indicato saranno riportate le righe con cui un orario va in conflitto.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15909
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Confronto data orario con altra data orario

Postdi SaturnoGio » 16/07/18 18:31

Ciao Antony, grazie per la risposta, ho controllato, ed inserita la macro, e riporta gli accavallamenti, ma non me le riporta tutte, cioè il controllo lo fa sull'orario, riportandomi la riga.

ma ad esempio la riga 16 e la 17 non riscontra l'accavallamento

16-Entrata 21 uscita 0.30
17-Entrata 20 uscita 0.30

la riga 17 comprende anche le 21,

vecchio file

io sai cosa ho fatto ho fatto scrivere il seriale della data+le ore, quindi ho un numero di questo tipo per le entrate ed uscite

riga 16 1/6/18 entrata 20 = numero 43252,833, Uscita 0,30 = numero 43253,012

come vedi superando la mezzanotte ho fatto aggiungere 1 giorno, li ho arrotondati a 3 cifre decimali ed ho fatto il confronto con un altra riga, con un ciclo for...next.

ti allego la macro

Codice: Seleziona tutto
Sub Controlla(d1, d2, d3, d4 As Double, d5 As Double, rr)
Dim r, c, x, y, d, m1, m2, m3, h4, h5, n, n1, n2, n4, n5, k, k1, k2, k3
Dim k4 As Double, k5 As Double, k5a As Double, ka4 As Double, ka5 As Double, da4 As Double, da5 As Double, t0, t1, t2, t3, t4
Dim d4h As Double, d5h As Double, k4h As Double, k5h As Double

m1 = "LAVORATO SU PIU APPALTI E IN ORARI SOVRAPPOSTI"
m2 = "ORARI SOVRAPPOSTI"
m3 = "Controlla"
Application.enableevents = False
d4h = 1 / 24 * d4 + 1 / 1440 * d4 Mod 1 * 100
d5h = 1 / 24 * d5 + 1 / 1440 * d5 Mod 1 * 100
da4 = d1 + d4h
If d5h < d4h Then da5 = d1 + 1 + d5h Else da5 = d1 + d5h
da4 = Round(da4, 3)
da5 = Round(da5, 3)
For x = 3 To rr - 1 'Cells(Rows.Count, 1).End(xlUp).Row - 1
    k1 = Cells(x, 1): k2 = Cells(x, 2): k3 = Cells(x, 3): k4 = Cells(x, 4): k5 = Cells(x, 5): k = 0
    k4h = 1 / 24 * k4 + 1 / 1440 * k4 Mod 1 * 100
    k5h = 1 / 24 * k5 + 1 / 1440 * k5 Mod 1 * 100
    ka4 = k1 + k4h
    If k5h < k4h Then ka5 = k1 + 1 + k5h Else ka5 = k1 + k5h
    ka4 = Round(ka4, 3)
    ka5 = Round(ka5, 3)
    'controlla data e dipendente
    t0 = 0
    If k1 = d1 And k3 = d3 Then
        'controlla cantiere ed orari sovrapposti
        If k2 <> d2 Then
        'controlla orario
        x = x
'            If da4 >= ka4 And da5 <= ka5 Then t1 = 1
            For y = ka4 To ka5 Step 0.001
                y = Round(y, 3)
                If da4 = y Then
                    t0 = 1: Exit For
                End If
                If da5 = y Then
                    t0 = 1: Exit For
                End If
            Next y
            If t0 >= 1 Then
                Cells(rr, 7) = m1
            End If
        End If
        'controlla sovrapposizione orario stesso cantiere
        If k2 = d2 Then
        x = x
            For y = ka4 To ka5 Step 0.001
                y = Round(y, 3)
                If da4 = y Then
                    t0 = 1: Exit For
                End If
                If da5 = y Then
                    t0 = 1: Exit For
                End If
            Next y
            If t0 >= 1 Then
                Cells(rr, 7) = m2
            Else
                Cells(rr, 7) = m3
            End If
        End If
    End If
    If Cells(rr, 7) = "" Then Cells(rr, 7) = "Ok"
1 Next x
Application.enableevents = True
End Sub


ci sarà un casino per capire le variabili, ma le scrivo al momento che servono, spero che riesci a capirci qualcosa

con questa riesco almeno a risolvere quasi tutto, ma se la lanci, dove esce "Controlla" sono situazioni dubbie, alcune sono allarmi falsi ma altre sono positivi

le ho segnate ti passo il file, ci sono più voci

http://www.filedropper.com/provapresenze3

Ciao jSat
Avatar utente
SaturnoGio
Newbie
 
Post: 3
Iscritto il: 14/07/18 10:16

Re: Confronto data orario con altra data orario

Postdi Marius44 » 17/07/18 07:52

Ciao
Se ho capito bene cosa vorresti fare, prova con questa macro (che sicuramente avrà bisogno di "limature")
Codice: Seleziona tutto
Option Explicit

Sub TrasformaOrario_SegnalaErrore()
Dim ur As Long, i As Long, j As Long
Dim ent() As String, usc() As String, ora_ent(), ora_usc()
ur = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim ora_ent(3 To ur)
ReDim ora_usc(3 To ur)
For i = 3 To ur
  ent = Split(Cells(i, 4), ",")
  usc = Split(Cells(i, 5), ",")
  If UBound(ent) > 0 Then
    ora_ent(i) = Format(TimeValue(ent(0) & ":" & Left(ent(1) & "00", 2)), "hh:mm AM/PM")
  Else
    ora_ent(i) = Format(TimeValue(ent(0) & ":00"), "hh:mm AM/PM")
  End If
  If UBound(usc) > 0 Then
    ora_usc(i) = Format(TimeValue(usc(0) & ":" & Left(usc(1) & "00", 2)), "hh:mm AM/PM")
  Else
    ora_usc(i) = Format(TimeValue(usc(0) & ":00"), "hh:mm AM/PM")
  End If
Next i
Columns("Q").ClearContents
For i = 3 To ur - 1
  For j = i + 1 To ur
    If Cells(i, 1) = Cells(j, 1) And Cells(i, 3) = Cells(j, 3) Then
      'se ora_ent(j) >= ora_ent(i) and ora_usc(j) <= ora_usc(i)
      'se ora_ent(j) < ora_ent(i) and ora_usc(j) <= ora_usc(i)
      If (ora_ent(j) >= ora_ent(i) Or ora_ent(j) < ora_ent(i)) And ora_usc(j) <= ora_usc(i) Then Cells(j, 17) = "err 1"
      'se ora_ent(j) >= ora_ent(i) and ora_usc(j) > ora_usc(i)
      'se ora_ent(j) < ora_ent(i) and ora_usc(j) > ora_usc(i)
      If (ora_ent(j) >= ora_ent(i) Or ora_ent(j) < ora_ent(i)) And ora_usc(j) > ora_usc(i) Then Cells(j, 17) = "err 2"
    End If
  Next j
Next i
End Sub

Cosa fa la macro?
Per prima cosa trasforma le cifre delle colonne orario Entrata e Uscita in orari formattati in hh:mm AM/PM e le assegna a due variabili.
Quindi scorre l'elenco per confrontate date e dipendente (il confronto cantiere mi sembra superfluo) e quando vi è corrispondenza confronta se l'orario della variabile di entrata e della variabile di uscita sono congrui: se non lo sono scrive errore in col.Q
In tal modo segnala gli errori che tu dicevi "dubbi".

Fai sapere. Ciao,
Mario
Marius44
Utente Senior
 
Post: 385
Iscritto il: 07/09/15 22:00

Re: Confronto data orario con altra data orario

Postdi cromagno » 17/07/18 14:18

Ciao a tutti,

ieri sera avevo iniziato la mia "prova" ma ho trovato solo ora il tempo per terminarla...magari si è già risolto con l'intervento di Mario (ciao). Comunque...

Prendendo l'ultimo file allegato, nel modulo di classe del foglio:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RngInOut As Range
    Dim i As Byte
    Dim UR As Long
    Dim Valori As Byte
   
    Set RngInOut = Range("D3:E" & Rows.Count)
    If Not Intersect(Target, RngInOut) Is Nothing Then
        For i = 1 To 5
            If Cells(Target.Row, i).Value <> "" Then
                Valori = Valori + 1
            End If
        Next i
       
        If Valori = 5 Then
            UR = Range("A" & Rows.Count).End(xlUp).Row - 2
            Call Verifica(UR)
        End If
    End If
End Sub


in un modulo standard:
Codice: Seleziona tutto
Sub Verifica(ByVal uRiga As Long)
    Dim Matr()
    Dim i As Long
    Dim j As Long
    Dim AppIn As Integer
    Dim AppOut As Integer
    Dim Entrata As Date
    Dim Uscita As Date
    Dim Esito As Byte
   
    'Colonne Matr --> Lavoratore / Cantiere / Data+Ora(IN) / Data+Ora (OUT) / Esito num / Esito Testo
    ReDim Matr(1 To uRiga, 1 To 6)
    For i = 1 To uRiga
        Matr(i, 1) = Cells(i + 2, 3).Value
        Matr(i, 2) = Cells(i + 2, 2).Value
        'Data e ora In
        AppIn = Int(Range("D" & i + 2).Value)
        Entrata = Cells(i + 2, 1).Value + AppIn / 24
        AppIn = (Range("D" & i + 2).Value - AppIn) * 100
        Entrata = Entrata + TimeSerial(0, AppIn, 0)
        'Data e ora Out
        AppOut = Int(Range("E" & i + 2).Value)
        Uscita = Cells(i + 2, 1).Value + AppOut / 24
        AppOut = (Range("E" & i + 2).Value - AppOut) * 100
        Uscita = Uscita + TimeSerial(0, AppOut, 0)
       
        If Uscita <= Entrata Then Uscita = Uscita + 1
       
        Matr(i, 3) = Entrata
        Matr(i, 4) = Uscita
        Matr(i, 6) = 0
    Next i
   
    'Elimino i colori e i vecchi esiti
    Range("D3:E" & ActiveSheet.UsedRange.Rows.Count).Interior.ColorIndex = xlNone
    Range("G3:G" & ActiveSheet.UsedRange.Rows.Count).ClearContents
    'Controllo orari sovrapposti
        'Per gli ESITI:
        '0 = "OK"
        '1 = "ORARI SOVRAPPOSTI"
        '2 = "LAVORATO SU PIU CANTIERI E IN ORARI SOVRAPPOSTI"
    For i = 1 To UBound(Matr, 1)
        For j = 1 To UBound(Matr, 1)
            If i <> j And Matr(i, 1) = Matr(j, 1) Then
                If (Matr(i, 3) >= Matr(j, 3) And Matr(i, 3) <= Matr(j, 4)) Or _
                    (Matr(i, 4) >= Matr(j, 3) And Matr(i, 4) <= Matr(j, 4)) Then
                   
                    Esito = IIf(Matr(i, 2) = Matr(j, 2), 1, 2)
                    If Esito > Matr(i, 6) Then Matr(i, 6) = Esito
                    If Esito > Matr(j, 6) Then Matr(j, 6) = Esito
                End If
            End If
           
            Select Case Matr(i, 6)
                Case Is = 0
                    Matr(i, 5) = "OK"
                Case Is = 1
                    Matr(i, 5) = "ORARI SOVRAPPOSTI"
                Case Is = 2
                    Matr(i, 5) = "LAVORATO SU PIU CANTIERI E IN ORARI SOVRAPPOSTI"
            End Select
           
            Select Case Matr(j, 6)
                Case Is = 0
                    Matr(j, 5) = "OK"
                Case Is = 1
                    Matr(j, 5) = "ORARI SOVRAPPOSTI"
                Case Is = 2
                    Matr(j, 5) = "LAVORATO SU PIU CANTIERI E IN ORARI SOVRAPPOSTI"
            End Select
        Next j
    Next i
   
    'Copio la Matrice sul Foglio e coloro le celle con incongruenze
    For i = 1 To UBound(Matr, 1)
        If Matr(i, 6) > 0 Then
            Range(Cells(i + 2, 4), Cells(i + 2, 5)).Interior.ColorIndex = 6
        End If
        Range("G" & i + 2).Value = Matr(i, 5)
    Next i
   
End Sub


il file lo puoi scaricare da qui:
https://www.dropbox.com/s/n98pqhzfq9yex2s/prova%20presenze3%20-%20Cro.xlsm?dl=0

Ciao
Tore

[EDIT]

le colonne 5 e 6 della matrice "Matr" ("Esito num" e "Esito Testo") alla fine ho deciso di invertirle (rispetto a quanto scritto nella nota nel codice), ma mi son dimenticato di correggere la nota :D
Ultima modifica di cromagno su 17/07/18 14:23, modificato 1 volte in totale.
Windows 10 + Office 2016 (ita)
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Avatar utente
cromagno
Utente Junior
 
Post: 58
Iscritto il: 08/10/16 16:33
Località: Sardegna

Re: Confronto data orario con altra data orario

Postdi Anthony47 » 17/07/18 14:23

Hai gia' una proposta di Marius e una di Cromagno (vedi sopra), che probabilmente risolvono i tuoi dubbi.

Quanto alla mia macro, mi si erano incrociati gli occhi al momento del controllo. Prova sostituendo la riga If Cells(I, 4) >= Cells(J, 4) And iOut <= jOut Then con
Codice: Seleziona tutto
                If iOut >= Cells(J, 4) And Cells(I, 4) <= jOut Then


Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15909
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Confronto data orario con altra data orario

Postdi SaturnoGio » 18/07/18 09:38

Ciao Grazie a tutti, funzionano entrambe ora però le riguardo bene per studiarmele e capire dove sbagliavo.

Come posso inserire "Risolto"?

mi avete risolto un ennesimo problema, grazie :)

Ciao JSat
Avatar utente
SaturnoGio
Newbie
 
Post: 3
Iscritto il: 14/07/18 10:16

Re: Confronto data orario con altra data orario

Postdi Anthony47 » 18/07/18 14:07

Come posso inserire "Risolto"?
Non c'e' bisogno di questa indicazione, perche' qui tutti i quesiti vengono risolti :D

Beh, quasi tutti :D :D

Alla prossima!
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15909
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Confronto data orario con altra data orario":


Chi c’è in linea

Visitano il forum: alfrimpa, danibi60 e 20 ospiti