Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Cambio colore se le giornate lavorative continue sono uguali

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

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Simo1 » 28/05/19 18:45

Ecco in pratica con la private Sub Worksheet_Change vorrei che oltre al lavoro che già dovrebbe effettuare il conteggio. Esempio nella riga 33 colonna AO e BA E BN E BY E BZ E CK venga colorata di rosso se la somma (sempre come esempio) il turno dalla cella AU33 alla BE33se la somma dei turni e 6 si evidenzi BA E AO e ovviamente il turno nelle celle tenendo presente che le celle da saltare sono AW33 AX33 AY33 AZ33 BA33.
Spero di essermi spiegato in modo comprensibile questa volta :-)
Simo1
Utente Junior
 
Post: 57
Iscritto il: 21/11/18 08:41

Sponsor
 

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Anthony47 » 28/05/19 18:59

Si pero' non farmi tornare alla casella iniziale: quale e' la macro con cui stai lavorando?
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: 16566
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Simo1 » 28/05/19 19:37

Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myC As Range, I As Long, WDCnt As Long, J As Long
'
pPausa = Array("R", "F", "P", "A")          '<<< Le sigle che interrompono la sequenza lavorativa
'
For Each myC In Target
    If myC.Column < 32 Then
    I = Target.Row
        Cells(I, 1).Interior.Color = xlNone
        Cells(I, 1).Resize(1, 32).Font.Color = RGB(0, 0, 0)
        If Cells(I, 1) <> "" Then
            WDCnt = 0
            For J = 2 To 31
                If Cells(I, J) <> "" Then
                    mymatch = Application.Match(Cells(I, J), pPausa, False)
                    If IsError(Application.Match(Cells(I, J), pPausa, False)) Then
                        WDCnt = WDCnt + 1
                        If WDCnt >= 6 Then
                            RepCnt = RepCnt + 1
                            Cells(I, 1).Interior.Color = RGB(255, 0, 0)
                            Cells(I, J).Offset(0, -WDCnt + 1).Resize(1, WDCnt).Font.Color = RGB(255, 0, 0)
                        End If
                    Else
                        WDCnt = 0
                    End If
                Else
                    WDCnt = 0
                End If
            Next J
        End If
    End If
Next myC
End Sub
Simo1
Utente Junior
 
Post: 57
Iscritto il: 21/11/18 08:41

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Anthony47 » 29/05/19 18:26

Scusa, tu disponi i dati in tutt'altro ordine e vieni a chiedere che cosa devi modificare nella macro affinche' funzioni anche su quel tracciato?
Poi speravo che il file aiutasse a capire la richiesta, ma la frase "Esempio nella riga 33 colonna AO e BA E BN E BY E BZ E CK venga colorata di rosso se la somma (sempre come esempio) il turno dalla cella AU33 alla BE33se la somma dei turni e 6 si evidenzi BA E AO e ovviamente il turno nelle celle tenendo presente che le celle da saltare sono AW33 AX33 AY33 AZ33 BA33" mi rimane ancora ininterpretabile (anche perche' priva di punti, virgole, punti e virgole e forse anche di accenti).

Mi limito quindi a guardare il nuovo tracciato e ad adottare su questo tracciato le regole che ricordo dal vecchio quesito, cioe' evidenziare sul mese i periodi consecutivi di lavoro lunghi 6 o piu' turni.

Per fare questo utilizzero' le date scritte su riga 29, skippando quindi le celle che in riga 29 non hanno una data e skippando anche le celle che non contengono nessun turno (queste celle saranno ignorate, come non esistessero).
Do' per scontato che l'inizio e' in colonna AP=42, e il calcolo sara' fatto su 5 settimane che si esauriscono in colonna CR=96; ma questi limiti sono impostabili nel codice

Do' per scontato che una riga corrisponde sempre allo stesso nominativo.

La macro interverra' se in colonna AN e' presente la sigla C.T., Sorv. Oppure VVF (comunque l'elenco e' definito nella macro, e quindi puo' essere variato nel codice), e se la colonna e' compresa tra la minima (42) e la massima (96), e se la riga e' superiore a quella con la data (29), e se la cella non e' vuota.

In caso di sequenze di 6 o piu' giorni lavorativi (non interrotti da una sigla di Riposo):
-tutti i turni lavorativi consecutivi sono colorati in rosso
-lo sfondo del nominativo (che immagino sia in colonna AO) viene colorato in rosso
Nel calcolo vengono ignorate le celle che in riga 29 non hanno una data valida o che comunque siano celle vuote.

In caso di turno "di riposo" la cella viene colorata in giallino; questa prestazione puo' essere eliminata cancellando nel codice successivo la riga marcata ***

Tutto cio' viene realizzato dalla seguente macro di Worksheet_Change:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myC As Range, I As Long, WDCnt As Long, J As Long, rDate As Long
Dim pTitle, iCol As Long, eCol As Long, tCol As Long, K As Long, rCnt As Long
'
pPausa = Array("R", "F", "P", "A")          '<<< Le sigle che interrompono la sequenza lavorativa
pTitle = Array("C.T.", "Sorv.", "VVF")      '<<< Le sigle dei lavoratori
tCol = 40                                   '<<< La colonna con le sigle, AN=40
rDate = 29                                  '<<< La riga con le date
iCol = 42                                   '<<< La colonna di inizio, AN=42
eCol = 96                                   '<<< La colonna di fine, CR=96
'
For Each myC In Target
    'Sigla valida in AN, colonna tra Min e Max, riga oltre riga data?
    If Not IsError(Application.Match(Cells(myC.Row, tCol).Value, pTitle, False)) And _
       myC.Column >= iCol And myC.Column <= 96 And myC.Row > rDate Then
        I = myC.Row                                                         'Riga di lavoro
        Cells(I, iCol - 1).Interior.Color = xlNone                          'Scolora area nominativo
        Range(Cells(I, iCol), Cells(I, eCol)).Interior.Color = xlNone       'Scolora area dei turni
        Range(Cells(I, iCol), Cells(I, eCol)).Font.Color = RGB(0, 0, 0)     'Scolora Font turni
        WDCnt = 0                                                           'Azzera contatore gg lavorati
        For J = iCol To eCol
            If Cells(I, J) <> "" And IsDate(Cells(rDate, J).Value) Then     'Data + Turno presente
                mymatch = Application.Match(Cells(I, J), pPausa, False)
                If IsError(Application.Match(Cells(I, J), pPausa, False)) Then
                    Cells(I, J).Interior.Color = xlNone                     'Se giorni lavorativi
                    WDCnt = WDCnt + 1
                    If WDCnt >= 6 Then                                      'Se >= 6 gg lavorativi:
                        RepCnt = RepCnt + 1
                        Cells(I, tCol).Offset(0, 1).Interior.Color = RGB(255, 0, 0) 'Colora Nominativo
                        rCnt = 0
                        For K = 0 To 100                                    'colora all'indietro
                            'Considera solo le celle "Con data" e "Con turno":
                            If IsDate(Cells(rDate, J - K)) And Cells(I, J - K) <> "" Then
                                Cells(I, J).Offset(0, -K).Font.Color = RGB(255, 0, 0)
                                rCnt = rCnt + 1
                                If rCnt >= WDCnt Then Exit For                  'Fine dopo N celle
                            End If
                        Next K
                    End If
                Else                                                        'Se giorni di riposo
                    Cells(I, J).Interior.Color = RGB(255, 255, 150)         '*** Evidenzia in giallino
                    WDCnt = 0                                               'Azzera contatore
                End If
            End If
        Next J
    End If
Next myC
End Sub


Va inserita nel modulo vba del foglio su cui si lavora, che puo' essere raggiunto (partendo da Excel) con Tasto dx sul tab col nome del foglio, scelta "Visualizza Codice"
Ovviamente da questa posizione vanno rimosse eventuali macro di Worksheet_Change gia' presenti.

Le righe marcate <<< consentono delle personalizzazioni come detto nel commento.

I ricchi commenti ti aiuteranno a fare le dovute variazioni nel caso che in futuro cambiassi ancora "qualche piccolo dettaglio".

Il file su cui ho provato e' scaricabile qui: https://www.dropbox.com/s/quix1c752k6d7 ... .xlsm?dl=0

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: 16566
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Simo1 » 29/05/19 19:13

Ciao hai ragione scusami e che avevo scritto di fretta e col cellulare..... Poi per cercare di spiegare un qualcosa su excel di cui non sono per niente ferrato anzi, vado per tentativi..... E sempre un disastro. Ora la provo cmq.

Più che altro ho anche sbagliato ad allegarti la macro perché era qualla originale, io poi l ho modificata adattandola alla griglia delle settimane.

Chiedo venia :-(

Solo una curiosità, come mai con la macro inserita nel codice foglio, quando vado a trascinare una cella non mi permette di modificare il tutto tenendo o meno la formattazione? E sopratutto perché non mi da la possibilità di tornare indietro al lavoro precedente?

Scusa la mia ignoranza ma sono proprio proprio al livello base
Simo1
Utente Junior
 
Post: 57
Iscritto il: 21/11/18 08:41

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Simo1 » 29/05/19 20:22

L ho provata e così come prima impressione va benissimo, poi la provo con calma.
Nel caso..... Per far evidenziare la cella col nome, di tutte le settimane? Quale dato devo aggiungere?

Grazie ancora
Simo1
Utente Junior
 
Post: 57
Iscritto il: 21/11/18 08:41

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Anthony47 » 30/05/19 22:49

L'evento "Worksheet_Change" intercetta le modifiche sul foglio e fa scattare la macro che abbiamo aggiunto; questo ovviamente interferisce con alcune tecniche di lavoro, sia sul "trascinamento" che viene interrotto al primo cambiamento. Come pure la catena di Undo viene resettata dalle macro.

Quanto a colorare le celle in tutte le settimane, devi intervenire in due posizioni:
A) Devi replicare questa istruzione per "scolorare" in modo preventivo tutte le 5 celle:
Codice: Seleziona tutto
        Cells(I, iCol - 1).Interior.Color = xlNone                          'Scolora area nominativo


Per questo, ti bastera' aggiungere 4 istruzioni analoghe
Codice: Seleziona tutto
        Cells(I, iCol - 1+XX).Interior.Color = xlNone                          'Scolora area nominativo

con XX pari a 12, 24, 36, 48

B) Analogo intervento sull'istruzione che colora:
Codice: Seleziona tutto
Cells(I, tCol).Offset(0, 1).Interior.Color = RGB(255, 0, 0) 'Colora Nominativo


Quindi 4 ulteriori istruzioni del tipo
Codice: Seleziona tutto
Cells(I, tCol).Offset(0, 1+ XX).Interior.Color = RGB(255, 0, 0) 'Colora Nominativo

Sempre con XX pari a 12, 24, 36, 48


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: 16566
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cambio colore se le giornate lavorative continue sono ug

Postdi Simo1 » 05/06/19 10:00

La funzione ora è perfetta e fa quello per cui è stata creata. Grazie mille sempre il top :-)
Simo1
Utente Junior
 
Post: 57
Iscritto il: 21/11/18 08:41

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Cambio colore se le giornate lavorative continue sono uguali":


Chi c’è in linea

Visitano il forum: Marius44 e 13 ospiti