Pagina 1 di 2 12 UltimaUltima
Risultati da 1 a 30 di 32

Discussione: Acquisizione timbrature



  1. #1
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Acquisizione timbrature

    Salve a tutti
    dovrei fare un lavoro di acquisizione timbrature ingresso/uscita che si trovano su file .txt generale scaricato da un sofware di timbrature e trasferirle su un file excel di gestione delle presenze per ricavare gli orari di lavoro di un dipendente.
    Premetto che devo partire da zero con la creazione di macro.
    Occorre usare per forza il VBA o basta inserire i diversi file in un database di access e collegarli?
    Scusate se sto dicendo delle grandi cavolate ma non saprei come impostare il lavoro
    Grazie
    File Allegati File Allegati

  2. #2
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Ciao Rosaria
    Non saprei se occorre il VBA o lo formule finchè non ci spieghi esattamente quello che vuoi, cerca di essere più concisa e descrittiva specificando in quale foglio ed in quale cella vorresti il risultato, specifica se devi estrarre qualcosa da dove e perchè
    Ciao

  3. #3
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    ok mi spiego meglio:
    1. nel file personale ho aggiunto i nomi dei dipendenti con il numero del badge e la matricola abbinata
    2. il file cartellino è quello che io scarico direttamente dal software delle timbrature codificato contenente: numero di matricola, data, orario ingresso (o uscita) seguito dalla lettera E o U a seconda che sia appunto ingresso o uscita.

    Io vorrei tramite una macro di acquisizione timbrature creata nel mese di gennaio, febbraio, marzo ecc. , acquisire gli orari relativi al numero di badge del dipendente che si trovano in quel file .txt codificato e inserirli nelle celle relative a ingresso e uscita, inn modo che lo statino si compili automaticamente.
    Mi è difficile spiegarlo ma spero di essere stata chiara

  4. #4
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    ok adesso è meglio anche se il problema si annuncia abbastanza articolato, a meno che si facesse pulizia nel foglio cartellino, nel senso di dividere colonna per colonna matricola, Data e orario pero fin adesso sono riuscito ad estrarre solo la matricola che è posizionato dal settimo carattere, al 16 carattere

    Esempio questo codice corrisponde esattamente a che cosa?

    001000001580869720160204160503U0000000000XXXXXXXXXXXXXXXXX

    la parte in rosso è la matricola ?
    la parte in verde è l'anno?
    la parte marrone è il mese?
    la parte in viola è giorno?
    la parte in arancione ora minuti secondi?
    la parte in blu è l'uscita o entrata?
    se questo è corretto e se la distanza è sempre la stessa si possono estrarre in campi diversi,
    a quel punto dopo aver messo tutti i dati in ordine si comincerà con l'analisi dei dati

    fammi sapere se quanto sopra è coretto?
    Ultima modifica fatta da:Gerardo Zuccalà; 21/05/16 alle 19:05

  5. #5
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    certo Gerardo
    è corretto!

  6. #6
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    ok, andiamo per ordine, prima sistemiamo il foglio cartellino
    Allora nel foglio cartellino metti le seguenti formula

    Per la matricola nella cella B2 metti questa formula e trascinala in basso
    =STRINGA.ESTRAI(A2;9;8)


    Per la data nella cella C2..... e poi formatta con gg/mm/aa
    =DATA(STRINGA.ESTRAI(A2;17;4);STRINGA.ESTRAI(A2;21;2);STRINGA.ESTRAI(A2;23;2))


    Per l'orario nella cella D2......e poi formattala con hh:mm:ss
    =ORARIO(STRINGA.ESTRAI(A2;25;2);STRINGA.ESTRAI(A2;27;2);STRINGA.ESTRAI(A2;29;2))

    Per Entrata e uscita nella cella E2 metti questa formula
    =STRINGA.ESTRAI(A2;31;1)

    fammi sapere!

  7. #7
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    ok fatto!

  8. #8
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Bene, adesso nel foglio di gennaio dovresti mettere le date vere, perchè saranno dei numeri seriali che si confronteranno con i numeri seriali del foglio cartellino
    B7:B37 scrivi 1/1/2016 e trascini in basso e otterai
    01/01/2016
    02/01/2016
    03/01/2016
    04/01/2016
    05/01/2016
    06/01/2016
    07/01/2016
    08/01/2016
    09/01/2016
    10/01/2016
    11/01/2016
    12/01/2016
    13/01/2016
    14/01/2016
    15/01/2016
    16/01/2016
    17/01/2016
    18/01/2016
    19/01/2016
    20/01/2016
    21/01/2016
    22/01/2016
    23/01/2016
    24/01/2016
    25/01/2016
    26/01/2016
    27/01/2016
    28/01/2016
    29/01/2016
    30/01/2016
    31/01/2016

  9. #9
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Citazione Originariamente Scritto da Rosaria79 Visualizza Messaggio
    ok fatto!
    Correggi la formula in B2 del foglio cartellino perchè ho messo 2 zero in meno davanti
    cosi:
    =STRINGA.ESTRAI(A2;7;10)

  10. #10
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    ok ho fatto!
    ovviamente dovrei cancellare la colonna C7:C37 ma dovrei prima rivedere tutte le formule del foglio Excel perché molte dipendono da questa colonna

  11. #11
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Citazione Originariamente Scritto da Rosaria79 Visualizza Messaggio
    ok ho fatto!
    ovviamente dovrei cancellare la colonna C7:C37 ma dovrei prima rivedere tutte le formule del foglio Excel perché molte dipendono da questa colonna

    No no lasciala pure quella colonna non da fastidio

  12. #12
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    ok lascio ma ho impostato il formato personalizzato gg...cambia qualcosa?

  13. #13
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Meglio il formato gg/mm/aa

    Adesso modifica le date anche a febbraio, perchè ho notato che nel foglio cartellino non c'è il mese di gennaio....

    Adesso vai nel foglio febbraio e metti il numero di matricola di un qualsiasi lavoratore nella Cella A1 Pre_Formattata a testo

    e inserisci questa formula in D7 copia in basso e a destra

    =SE.ERRORE(CERCA(2;1/((Matricola=$B$1)*(data=$B7)*(E_U=SINISTRA(D$6;1)));ora);"")

    solo che ho notato che qualcuno non timbra l'uscita


    Dimenticavo ho definito con i nomi i nuovi campi e cancella quelli vecchi

    r
    iferito a data =Cartellino!$C$2:$C$714

    riferito a ora =Cartellino!$D$2:$D$714

    riferito a matricola =Cartellino!$B$2:$B$714

    riferito E_U =Cartellino!$E$2:$E$714

    Ti allego il file prchè vado di fretta intanto controlla Febbriao e dimmi se trovi delle incongruenze
    Ovviamente ci sono anche altre soluzioni
    Scappo che mi stanno aspettando
    un saluto
    File Allegati File Allegati

  14. #14
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    si alcune timbrature mancano perché siamo ancora in fase di sperimentazione. In ogni modo se dovesse succedere non potrei aggiungere l'orario manualmente perché ho notato che hai inserito le formule nelle celle.
    Hai detto che ci sono altre soluzioni.. quali potrebbero essere?
    Comunque grazie

  15. #15
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Citazione Originariamente Scritto da Rosaria79 Visualizza Messaggio
    si alcune timbrature mancano perché siamo ancora in fase di sperimentazione. In ogni modo se dovesse succedere non potrei aggiungere l'orario manualmente perché ho notato che hai inserito le formule nelle celle.
    Hai detto che ci sono altre soluzioni.. quali potrebbero essere?
    Comunque grazie
    Eccoci Qua!
    Per altre soluzioni intendevo ovviamente con altre formule, oppure con il VBA, anche se quest'ultima soluzione non credo che riesce a risolvere il problema, nel senso che se te inserisci manualmente gli orari, quando poi andrai ad eseguire una eventuale MACRO, sovrascriverà gli orari scritti a mano, perchè i dati li ha ripresi dal foglio "cartellino", vorrei essere smentito da qualche esperto VBA...
    Comunque credo che se non si visualizza un orario sia un vantaggio, perchè almeno sai chi timbra e chi no.....e quindi ti serve per stimolare gli operatore a timbrare, altrimenti come fai a sapere chi ha timbrato e chi no?
    Un saluto

  16. #16
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    no Gerardo col VBA so che si può fare e, anche se si modifica manualmente un orario, ne rimane traccia. Tutto funziona tramite MACRO di inserimento orari, quando si preme la macro, automaticamente si inseriscono gli orari che sono nel file delle timbrature txt nella colonna entrata/uscita. Se manca una timbratura, si può modificare manualmente, ma se riaggiorno la macro mi ritornano gli orari presenti nel file. In questo modo rimane traccia delle modifiche effettuate.
    Naturalmente tutto ciò l'ho visto ma non lo so fare!!è per questo che mi sono rivolta a questo forum...vorrei cercare di riprodurre questa idea

  17. #17

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Acquisizione timbrature

    Io creerei un ciclo che identifica le mancate timbrature dal foglio cartellino per integrarle alla fine dello stesso foglio, poi avvierei un altro ciclo che le ricopia nel foglio presenze in base alla matricola.

    Inviato dal mio GT-I9301I utilizzando Tapatalk

  18. #18
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    a me non interessa tanto la timbratura che manca ma come inserire automaticamente le timbrature nella colonna ingresso o uscita tramite macro "GeneraOre"

  19. #19

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7183
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2067
    Likes dati
    1308

    Re: Acquisizione timbrature

    Ciao a tutti,
    se ho ben capito, Rosaria, vorresti una macro che inserisca automaticamente le timbrature nel rispettivo mese.
    Questa sub, come esempio, inserisce le timbrature (entrata e uscita) nel mese di febbraio.
    Codice: 
    Option Explicit
    Sub inserisci()
    Dim wks1 As Worksheet, wks2 As Worksheet, cella As Range, y As Integer
    Set wks1 = Worksheets("Cartellino")
    Set wks2 = Worksheets("Febbraio")
        For Each cella In wks1.Range("B2:B714")
        For y = 7 To 35
            If cella = wks2.Range("B1") And wks2.Range("B" & y) = cella.Offset(0, 1) And cella.Offset(0, 3) = "E" Then
                wks2.Range("D" & y) = cella.Offset(0, 2)
            End If
            If cella = wks2.Range("B1") And wks2.Range("B" & y) = cella.Offset(0, 1) And cella.Offset(0, 3) = "U" Then
                wks2.Range("E" & y) = cella.Offset(0, 2)
            End If
        Next: Next
    End Sub
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  20. #20

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Acquisizione timbrature

    Ho creato una routine che estrae i dati dal foglio cartellino e li trascrive nel foglio mese (ho eliminato ogni singolo mese ora c'e un solo foglio statino). Con la scelta della Matricola - Mese - Anno e estrae i relativi dati.
    Codice: 
    Option Explicit
    
    
    Sub EstraiMese()
    Dim Matricola As String, Mese As String, Tipo As String
    Dim Mesi As Variant
    Dim iCount As Long, uRiga As Long
    Dim i As Integer, iMese As Integer, Giorno As Integer, iCol As Integer, Anno As Integer
    Dim orario As Double
    
    
    Matricola = Foglio11.Range("b1")
    
    
    Mese = Foglio11.Range("b4")
    Anno = Foglio11.Range("g4")
    
    
    Mesi = Array("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre")
    
    
    For i = 0 To 11
        If Mesi(i) = Mese Then
            Exit For
        End If
    Next
    
    
    iMese = i + 1
    
    
    Foglio11.Range("b7:i37").ClearContents
    
    
    For i = 1 To DateSerial(Anno, iMese + 1, 1) - DateSerial(Anno, iMese, 1)
        Foglio11.Cells(i + 6, 2) = DateSerial(Anno, iMese, i)
        Foglio11.Cells(i + 6, 3) = Left(Format(DateSerial(Anno, iMese, i), "ddd"), 2)
    Next
    
    
    uRiga = Foglio2.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    For iCount = 2 To uRiga
        If Mid(Foglio2.Cells(iCount, 1), 7, 10) = Matricola Then
            If Mid(Foglio2.Cells(iCount, 1), 17, 4) = Anno Then
                If Mid(Foglio2.Cells(iCount, 1), 21, 2) = 0 & iMese Then
                    'Stop
                    Giorno = CInt(Mid(Foglio2.Cells(iCount, 1), 23, 2))
                    Tipo = Mid(Foglio2.Cells(iCount, 1), 31, 1)
                    orario = TimeSerial(Mid(Foglio2.Cells(iCount, 1), 25, 2), Mid(Foglio2.Cells(iCount, 1), 27, 2), Mid(Foglio2.Cells(iCount, 1), 29, 2)) 'ORARIO(STRINGA.ESTRAI(A2;25;2);STRINGA.ESTRAI(A2;27;2);STRINGA.ESTRAI(A2;29;2))
                    Select Case Tipo
                        Case "E"
                            iCol = 4
                            Do Until Foglio11.Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Entrate esaurite" & Chr(13) & "L'entrata del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                End If
                            Loop
                        Case "U"
                            iCol = 5
                            Do Until Foglio11.Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Uscite esaurite" & Chr(13) & "L'uscita del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                    GoTo Successivo
                                End If
                            Loop
                    End Select
                    Foglio11.Cells(Giorno + 6, iCol) = orario
    Successivo:
                End If
            End If
        
        End If
    Next
    
    
    End Sub
    Fammi sapere se va bene.

    EDIT: Mentre creavo la routine Ges mi ha preceduto! (come al solito!)
    File Allegati File Allegati

  21. I seguenti 2 utenti hanno dato un "Like" a Rubik72 per questo post:


  22. #21

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7183
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2067
    Likes dati
    1308

    Re: Acquisizione timbrature

    Rubik!!!! TU mi spii nel computer!:167:
    Dopo aver postato la precedente macro ho fatto una cosa simile alla tua!!! :261:

    Ho previsto persino che i giorni si modifichino 29-30 o 31 in base ai mesi.

    [EDIT] - Ho detto "simile", vedo che il codice di Rubik è più completo ed evoluto rispetto al mio!
    Grande Rubik! :261:
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  23. I seguenti utenti hanno dato un "Like"


  24. #22
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    Grande ges ...fantastico!!
    è ciò che volevo ottenere! ho visto che hai usato il VBA che io non so usare. Riesco solo ad interpretarlo un pò e fare delle semplici cose!
    Grazie mille ...intanto metto risolto! Poi sono sicura che avrò ancora bisogno di te!

  25. #23
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    Grazie anche a te Rubik72,
    trovo geniale anche la tua intuizione! Mi piace anche la semplificazione dei mesi in un unico file! Grande.
    Adesso metterò in atto le vostre soluzioni e vi farò sapere.
    Grazie ancora! E tantissimi complimenti per il forum!!!

  26. #24

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Acquisizione timbrature

    Citazione Originariamente Scritto da Rosaria79
    [...]
    C'è unproblema però: ho bisogno di avere i mesi distinti perché inquesto modo mi permette di riportare i residui dei mese precedente o annoprecedente in automatico di ogni dipendente collegando i files mese per mese.Così riesco a tenere meglio la situazione delle ferie sotto controllo.[...]
    Ok, lo modifico quanto prima

    Citazione Originariamente Scritto da Rosaria79
    [...]P.S. il motivo per cui hai modificato i giorni della settimana (L, Ma; Me, ecc) è perché ti serviva la cella senza formula?[...]

    No semplicemente per snellire il file (le formule appesantiscono il file)

    P.S. Non scrivere in privato altrimenti altri utenti che sarebbero interessati alla soluzione sarebbero esclusi
    P.P.S. Libera la mail altrimenti i messaggi non ti arriveranno mai

  27. #25
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    pensavo la discussione fosse risolta e quindi chiusa:166:

    per i giorni no problem modifico le formule che contengono i giorni in formato TESTO

  28. #26

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Acquisizione timbrature

    Ho modificato leggermente il codice ed ho aggiunto i vari fogli dei 12 mesi:
    Codice: 
    Option Explicit
    
    
    Sub EstraiMese() 'Mese As String, Anno As Integer, Matricola As String)
    Dim Matricola As String, Mese As String, Anno As Integer
    Dim Tipo As String
    Dim Mesi As Variant
    Dim iCount As Long, uRiga As Long
    Dim i As Integer, iMese As Integer, Giorno As Integer, iCol As Integer
    Dim orario As Double
    
    
    Matricola = Range("b1")
    Mese = Range("b4")
    Anno = Range("g4")
    
    
    Mesi = Array("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre")
    
    
    For i = 0 To 11
        If Mesi(i) = Mese Then
            Exit For
        End If
    Next
    
    
    iMese = i + 1
    
    
    Range("b7:i37").ClearContents
    
    
    For i = 1 To DateSerial(Anno, iMese + 1, 1) - DateSerial(Anno, iMese, 1)
        Cells(i + 6, 2) = DateSerial(Anno, iMese, i)
        Cells(i + 6, 3) = Left(Format(DateSerial(Anno, iMese, i), "ddd"), 2)
    Next
    
    
    uRiga = Foglio2.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    For iCount = 2 To uRiga
        If Mid(Foglio2.Cells(iCount, 1), 7, 10) = Matricola Then
            If Mid(Foglio2.Cells(iCount, 1), 17, 4) = Anno Then
                If Mid(Foglio2.Cells(iCount, 1), 21, 2) = 0 & iMese Then
                    'Stop
                    Giorno = CInt(Mid(Foglio2.Cells(iCount, 1), 23, 2))
                    Tipo = Mid(Foglio2.Cells(iCount, 1), 31, 1)
                    orario = TimeSerial(Mid(Foglio2.Cells(iCount, 1), 25, 2), Mid(Foglio2.Cells(iCount, 1), 27, 2), Mid(Foglio2.Cells(iCount, 1), 29, 2)) 'ORARIO(STRINGA.ESTRAI(A2;25;2);STRINGA.ESTRAI(A2;27;2);STRINGA.ESTRAI(A2;29;2))
                    Select Case Tipo
                        Case "E"
                            iCol = 4
                            Do Until Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Entrate esaurite" & Chr(13) & "L'entrata del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                End If
                            Loop
                        Case "U"
                            iCol = 5
                            Do Until Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Uscite esaurite" & Chr(13) & "L'uscita del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                    GoTo Successivo
                                End If
                            Loop
                    End Select
                    Cells(Giorno + 6, iCol) = orario
    Successivo:
                End If
            End If
        
        End If
    Next
    
    
    End Sub
    File Allegati File Allegati

  29. I seguenti 2 utenti hanno dato un "Like" a Rubik72 per questo post:


  30. #27
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4937
    Versione Office
    2013
    Likes ricevuti
    1122
    Likes dati
    1131

    Re: Acquisizione timbrature

    Ho tolto RISOLTO cosi continua il Topic
    un saluto

  31. #28
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    E' fantastico!
    Grazie mille Rubik72!

  32. #29
    L'avatar di Rosaria79
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Ferrara
    Messaggi
    36
    Versione Office
    Excel 2016
    Likes ricevuti
    0
    Likes dati
    0

    Re: Acquisizione timbrature

    Citazione Originariamente Scritto da Rubik72 Visualizza Messaggio
    Ho modificato leggermente il codice ed ho aggiunto i vari fogli dei 12 mesi:
    Codice: 
    Option Explicit
    
    
    Sub EstraiMese() 'Mese As String, Anno As Integer, Matricola As String)
    Dim Matricola As String, Mese As String, Anno As Integer
    Dim Tipo As String
    Dim Mesi As Variant
    Dim iCount As Long, uRiga As Long
    Dim i As Integer, iMese As Integer, Giorno As Integer, iCol As Integer
    Dim orario As Double
    
    
    Matricola = Range("b1")
    Mese = Range("b4")
    Anno = Range("g4")
    
    
    Mesi = Array("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre")
    
    
    For i = 0 To 11
        If Mesi(i) = Mese Then
            Exit For
        End If
    Next
    
    
    iMese = i + 1
    
    
    Range("b7:i37").ClearContents
    
    
    For i = 1 To DateSerial(Anno, iMese + 1, 1) - DateSerial(Anno, iMese, 1)
        Cells(i + 6, 2) = DateSerial(Anno, iMese, i)
        Cells(i + 6, 3) = Left(Format(DateSerial(Anno, iMese, i), "ddd"), 2)
    Next
    
    
    uRiga = Foglio2.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    For iCount = 2 To uRiga
        If Mid(Foglio2.Cells(iCount, 1), 7, 10) = Matricola Then
            If Mid(Foglio2.Cells(iCount, 1), 17, 4) = Anno Then
                If Mid(Foglio2.Cells(iCount, 1), 21, 2) = 0 & iMese Then
                    'Stop
                    Giorno = CInt(Mid(Foglio2.Cells(iCount, 1), 23, 2))
                    Tipo = Mid(Foglio2.Cells(iCount, 1), 31, 1)
                    orario = TimeSerial(Mid(Foglio2.Cells(iCount, 1), 25, 2), Mid(Foglio2.Cells(iCount, 1), 27, 2), Mid(Foglio2.Cells(iCount, 1), 29, 2)) 'ORARIO(STRINGA.ESTRAI(A2;25;2);STRINGA.ESTRAI(A2;27;2);STRINGA.ESTRAI(A2;29;2))
                    Select Case Tipo
                        Case "E"
                            iCol = 4
                            Do Until Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Entrate esaurite" & Chr(13) & "L'entrata del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                End If
                            Loop
                        Case "U"
                            iCol = 5
                            Do Until Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Uscite esaurite" & Chr(13) & "L'uscita del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                    GoTo Successivo
                                End If
                            Loop
                    End Select
                    Cells(Giorno + 6, iCol) = orario
    Successivo:
                End If
            End If
        
        End If
    Next
    
    
    End Sub

    Ciao @Rubik72
    mi potresti commentare gentilmente il VBA?
    A parte le dichiarazioni che penso si inseriscono manualmente, per attivare la macro hai usato il registratore? Mi potresti spiegare passo passo il tutto?

    Naturalmente mi rivolgo a Rubik72 perché è l'autore del VBA ma chiunque mi volesse rispondere accetto volentieri
    Grazie a tutti.

  33. #30

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Acquisizione timbrature

    Ecco il codice con i commenti
    Codice: 
    ption Explicit
    
    
    
    
    Sub EstraiMese() 'Mese As String, Anno As Integer, Matricola As String)
    '===='Dichiarazioni delle variabili
    Dim Matricola As String, Mese As String, Anno As Integer
    Dim Tipo As String
    Dim Mesi As Variant
    Dim iCount As Long, uRiga As Long
    Dim i As Integer, iMese As Integer, Giorno As Integer, iCol As Integer
    Dim orario As Double
    
    
    '====assegnazione di valore alle variabili
    Matricola = Range("b1")
    Mese = Range("b4")
    Anno = Range("g4")
    
    
    '====assegnazione di valori ad una matrice
    Mesi = Array("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre")
    
    
    '====ciclo che cerca il numero del mese
    For i = 0 To 11
        If Mesi(i) = Mese Then
            Exit For
        End If
    Next
    
    
    '====visto che le matrici iniziano per 0 aggiungo 1 al risultato
    '==== 0=Gennaio, 1=Febbraio ecc
    iMese = i + 1
    
    
    '====cancello il contenuto del range
    Range("b7:i37").ClearContents
    
    
    '====ciclo che scrive i giorni nella colonna 2(numero) e 3(testo)
    For i = 1 To DateSerial(Anno, iMese + 1, 1) - DateSerial(Anno, iMese, 1)
        Cells(i + 6, 2) = DateSerial(Anno, iMese, i)
        Cells(i + 6, 3) = Left(Format(DateSerial(Anno, iMese, i), "ddd"), 2)
    Next
    
    
    '====assegnazione variabile ultima riga
    uRiga = Foglio2.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    '====ciclo di tutti i record
    For iCount = 2 To uRiga
        '====se record inizio caratt.7 per 10 caratt=Matricola
        If Mid(Foglio2.Cells(iCount, 1), 7, 10) = Matricola Then
            '====se record inizio carat.17 per 4 caratt=Anno
            If Mid(Foglio2.Cells(iCount, 1), 17, 4) = Anno Then
                '====se record inizio caratt.21 per 2 caratt=Mese
                If Mid(Foglio2.Cells(iCount, 1), 21, 2) = 0 & iMese Then
                    'Stop
                    '====assegna variabile giorno dal caratt.23 per 2 caratt
                    Giorno = CInt(Mid(Foglio2.Cells(iCount, 1), 23, 2))
                    '====assegna variabile Tipo dal caratt.31 per 1 caratt
                    Tipo = Mid(Foglio2.Cells(iCount, 1), 31, 1)
                    '====assegna variabile orario(ore,minuti,secondi)
                    orario = TimeSerial(Mid(Foglio2.Cells(iCount, 1), 25, 2), Mid(Foglio2.Cells(iCount, 1), 27, 2), Mid(Foglio2.Cells(iCount, 1), 29, 2)) 'ORARIO(STRINGA.ESTRAI(A2;25;2);STRINGA.ESTRAI(A2;27;2);STRINGA.ESTRAI(A2;29;2))
                    '====struttura di decisione Tipo
                    Select Case Tipo
                        Case "E"
                            '====assegna variabile colonna
                            iCol = 4
                            '====ricerca la prima colonna vuota delle entrate
                            Do Until Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Entrate esaurite" & Chr(13) & "L'entrata del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                End If
                            Loop
                        Case "U"
                            '====assegna variabile colonna
                            iCol = 5
                            '====ricerca la prima colonna vuota delle entrate
                            Do Until Cells(Giorno + 6, iCol) = ""
                                iCol = iCol + 2
                                If iCol > 8 Then
                                    MsgBox "Uscite esaurite" & Chr(13) & "L'uscita del giorno " & Giorno & " ore " & CDate(orario) & " non verrà memorizzata", vbInformation + vbOKOnly, "ATTENZIONE"
                                    GoTo Successivo
                                End If
                            Loop
                    End Select
                    '=== scrivi orario
                    Cells(Giorno + 6, iCol) = orario
    Successivo:
                End If
            End If
        
        End If
    Next
    
    
    
    
    End Sub
    Citazione Originariamente Scritto da Rosaria79 Visualizza Messaggio
    [...]
    A parte le dichiarazioni che penso si inseriscono manualmente, per attivare la macro hai usato il registratore?[...]
    Il codice è stato scritto tutto a mano

  34. I seguenti utenti hanno dato un "Like"


Discussioni Simili

  1. Acquisizione dati da MS Project 2016
    Di Pava1955 nel forum Domande su Excel VBA e MACRO
    Risposte: 1
    Ultimo Messaggio: 03/03/17, 12:31

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •