Sostieni Excel VBA con una donazione! Con la tua donazione potrai contribuire al mantenimento del servizio.
Le donazioni sono eseguite con PayPal, il modo più facile, comodo e sicuro per pagare online.
Paypal accetta anche carta di credito o carte prepagate.

Evidenziare determinati valori in più fogli

  • FILE ALLEGATI:
  • Evidenziare determinati valori in più fogli (2016) di metalmore (Utente) data: 07/01/2017 15:25:21 




    ciao a tutti...
    purtroppo sono un nabbo e dopo averci provato ( mi sono limitato semplicemente al più "user-friendly" formattazione condizionale e non sono riuscito ad ottenere ciò che cercavo ) ho deciso di provare a chiedere aiuto qui.

    ho un file con macro che è il CALCOLO_ORE, che serve a caricare un report che mi viene dato da un timbratore, estrapola i dati, mi fa una "prewiew" e al mio click sul tasto elabora, me li divide per dipendente e mi fa il subtotale e totale delle ore lavorate. premetto che questo sacro gral me l'ha fatto un ragazzo che ho conosciuto sul web.. se l'avessi fatto io probabilmente me la sarei cavata già da tempo

    la modifica che devo apportare penso sia piuttosto semplice per voi esperti.

    dopo aver elaborato il report caricato, mi dice che ci sono " Data/Orario " mancante in determinati fogli a seconda di chi non ha timbrato.
    in quel caso, nel foglio orari_2 dove ho un'anteprima generale di tutti i totali,

    dovrei metterci una macro che mi evidenzi tutti i singoli data/orario (se possibile evidenziarli nei singoli fogli) di tutti
    ciao a tutti...
    purtroppo sono un nabbo e dopo averci provato ( mi sono limitato semplicemente al più "user-friendly" formattazione condizionale e non sono riuscito ad ottenere ciò che cercavo ) ho deciso di provare a chiedere aiuto qui.

    ho un file con macro che è il CALCOLO_ORE, che serve a caricare un report che mi viene dato da un timbratore, estrapola i dati, mi fa una "prewiew" e al mio click sul tasto elabora, me li divide per dipendente e mi fa il subtotale e totale delle ore lavorate. premetto che questo sacro gral me l'ha fatto un ragazzo che ho conosciuto sul web.. se l'avessi fatto io probabilmente me la sarei cavata già da tempo

    la modifica che devo apportare penso sia piuttosto semplice per voi esperti.

    dopo aver elaborato il report caricato, mi dice che ci sono " Data/Orario " mancante in determinati fogli a seconda di chi non ha timbrato.
    in quel caso, nel foglio orari_2 dove ho un'anteprima generale di tutti i totali,

    dovrei metterci una macro che mi evidenzi tutti i singoli data/orario (se possibile evidenziarli nei singoli fogli) di tutti i ragazzi.

    ps. il calcolo ore non ha in memoria tutti i dipendenti, quindi ogni mese possono variare i nomi dei dipendenti che vengono caricati dal report del timbratore, non so se sia un'informazione che vi possa tornare utile.

    poi successivamente avrei un'altra richiesta che magari la scrivo dopo, se qualcuno è disponibile ad aiutarmi.. grazie mille..

    step (anche se penso non c'e ne sia bisogno)
    - aprire CALCOLO_ORE
    - spostarsi sul foglio REPORT
    - carica report
    - dare l'ok al msgbox di avviso orario mancante
    - elabora

    File allegati
  • di Gianfranco (Utente) data: 08/01/2017 20:32:10 



    ciao
    questo ti colora di azzurro
    le due colonne dove manca la data
    se vuoi cella per cella basta variarlo un pò
     
    Option Explicit
    Sub Carica_Report2()
    Dim sh1 As Worksheet: Set sh1 = Worksheets("Report_2")
    Dim sh2 As Worksheet: Set sh2 = Worksheets("Orari_2")
    Dim UR1 As Long, UR2 As Long, X As Long, R2 As Long, OrarioX As Date
    Dim Strfile As String, MXG As String
    Dim DData1 As Date, DData2 As Date
    OrarioX = sh1.Cells(2, 1)
    
    Application.ScreenUpdating = False
    UR1 = sh1.Range("C" & Rows.Count).End(xlUp).Row
        If UR1 > 1 Then
            sh1.Range(sh1.Cells(2, 3), sh1.Cells(UR1, 16)).ClearContents
        End If
    UR1 = sh2.Range("A" & Rows.Count).End(xlUp).Row
        If UR1 > 1 Then
            sh2.Range(sh2.Cells(2, 1), sh2.Cells(UR1, 16)).ClearContents
        End If
    
    Strfile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls", , "Seleziona il file e premi 'Apri'", , False)
    Workbooks.Open Strfile
    UR2 = Range("A" & Rows.Count).End(xlUp).Row
    Range(Cells(1, 1), Cells(UR2, 8)).Copy
    sh1.Cells(1, 3).PasteSpecial
    Application.DisplayAlerts = False
    ActiveWorkbook.Close sAVEcHANGES:=False
    Application.DisplayAlerts = True
    
    UR1 = sh1.Range("C" & Rows.Count).End(xlUp).Row
        sh1.Sort.SortFields.Clear
        sh1.Sort.SortFields.Add Key:=Range( _
            "E2:E" & UR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        sh1.Sort.SortFields.Add Key:=Range("F2:F" & UR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortTextAsNumbers
        With sh1.Sort
            .SetRange Range("C1:I" & UR1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    R2 = 2
    For X = 2 To UR1
        sh2.Cells(R2, 1) = sh1.Cells(X, 5)
        sh2.Cells(R2, 2) = CDate(sh1.Cells(X, 6))
        R2 = R2 + 1
    Next X
    For X = 2 To UR1
        If sh2.Cells(X + 1, 1) = "" Then Exit For
            DData1 = Fix(CDate(sh2.Cells(X, 2) - OrarioX))
            DData2 = Fix(CDate(sh2.Cells(X + 1, 2) - OrarioX))
            If DData1 = DData2 And sh2.Cells(X, 1) = sh2.Cells(X + 1, 1) Then
                sh2.Cells(X, 2) = sh2.Cells(X, 2)
                sh2.Cells(X, 3) = sh2.Cells(X + 1, 2)
            Else
                If sh1.Cells(X, 7) = "Ingresso" Then
                    sh2.Cells(X, 3) = "Data/Orario"
                    X = X - 1
                Else
                    sh2.Cells(X, 2) = "Data/Orario"
                    sh2.Cells(X, 3) = CDate(sh1.Cells(X, 6))
                    X = X - 1
                End If
            End If
            X = X + 1
    Next X
        sh2.Sort.SortFields.Clear
        sh2.Sort.SortFields.Add Key:=Range("C2:C" & UR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With sh2.Sort
            .SetRange Range("A1:C" & UR1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        UR2 = sh2.Range("C" & Rows.Count).End(xlUp).Row
        sh2.Range(sh2.Cells(UR2 + 1, 1), sh2.Cells(UR1, 16)).Clear
        
        sh2.Sort.SortFields.Clear
        sh2.Sort.SortFields.Add Key:=Range("A2:A" & UR2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        sh2.Sort.SortFields.Add Key:=Range("B2:B" & UR2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortTextAsNumbers
        With sh2.Sort
            .SetRange Range("A1:C" & UR2)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        With sh2.Range("F2:F" & UR2).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="Anticipo"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    UR2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
    R2 = 0
        For X = 2 To UR2
            If sh2.Cells(X, 2) = "Data/Orario" Or sh2.Cells(X, 3) = "Data/Orario" Then
            sh2.Cells(X, 2).Interior.ColorIndex = 34
            sh2.Cells(X, 3).Interior.ColorIndex = 34
                MXG = MXG & "inserire l'orario alla riga " & X & vbCrLf
                R2 = R2 + 1
            End If
        Next X
        sh2.Range("B2:E" & UR1).NumberFormat = "d/m/yy h.mm;@"
        sh2.Range("H2:J" & UR1).NumberFormat = "h.mm;@"
        sh2.Range("M2:O" & UR1).NumberFormat = "[h]:mm:ss;@"
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        sh2.Columns("A:C").EntireColumn.AutoFit
        sh2.Activate
        Set sh1 = Nothing
        Set sh2 = Nothing
        If R2 > 0 Then MsgBox (MXG) Else MsgBox "Caricato il Report"
    End Sub
  • di metalmore (Utente) data: 09/01/2017 18:39:41 



    ciao gianfranco..

    grazie per il celere aiuto!!

    all'inizio, prima di copiarlo e incollarlo senza ritegno ho provato ad occhio a cercare la differenza dei due codici e avendoci guardato due volte non ho trovato differenze... poi stavo per scrivere che magari ti eri sbagliato a copiarmi il codice e ho detto, prima di fare figure di m.... provo a copiarlo e funziona perfettamente!!

    poi ho riaperto il codice ricercando nuovamente qualche cosa che mi potesse portare ai colori rgb per cambiarlo a mio piacimento ma non trovo niente.. come posso operare per avere un colore più acceso?? sono accecato...

    è poossibile fare in modo che dopo aver premuto elabora, tornare alla schermata al foglio Orari_2?

    poi, volevo chiedere un informazione, secondo te si riesce ad avere una macro nel foglio Orari_2,dopo aver elaborato il report,che per ogni mancata timbratura mi calcoli 4 ore diurne in più??

    cerco di spiegarmi meglio..

    io luca ho fatto 100 ore e ho due timbrature mancanti, dopo aver caricato il report mi avvisa che ci sono timbrature mancanti con il msgbox ee il colore nelle celle, elaboro poi premo la macro per aggiungere 4 ore per OGNI timbrata mancante, e quindi mi trasformerà quelle 100 ore in 108

    provo ad alllegare uno screen


  • di Gianfranco (Utente) data: 09/01/2017 20:14:20 



    Ciao
    per colori rgb sistemato
    per foglio dopo elaborazione fatto
    per il calcolo ho difficoltà
    non sono espertissimo di VBA
    ma ci provo
    dovrebbe bastare aggiungere COUNTIF e vedere dove inserirlo
    domani ci provo

    vedi il file cartella 3
  • di metalmore (Utente) data: 13/01/2017 17:22:37 



    ciao gianfranco..

    grazie per l'aiuto.. avevo visto la risposta qualche gg fa ma non avevo modo di provare la funzione..

    il conta.se sembra fare al caso mio.. però non svolge quello che cerco.. forse c'è da integrare un'ulteriore funzione.. provo a spulciare qualcosa..

    PER OGNI data/orario che c'è in B:C deve darmi la possibilità di moltiplicare per 4 ore e aggiungerle al totale ore già effettuato..

    se qualcun'altro che legge la discussione sa come agire...
  • torna su

Sostieni Excel VBA con una donazione! Con la tua donazione potrai contribuire al mantenimento del servizio.
Le donazioni sono eseguite con PayPal, il modo più facile, comodo e sicuro per pagare online.
Paypal accetta anche carta di credito o carte prepagate.