Adattare Worksheet

[Simo1]

Buona sera ho questa worksheet che vorrei adattare a una solo settimana, il più e fatto, solo che non so come fare nonostante le interruzioni a far sommare i giorni avorativi e far risultare colorate le celle anche se la R interrompe la sequenza, mi servirebbe che la macro calcoli i giorni lavorati nel complessivo. Ossia se lavoro sei giorni nell'arco della settimana con un solo riposo deve colorare le celle caso contrario se ci sono due R anche se in posizioni diverse della settimana, in quanto ora come ora mlo evidenzia solo se i giorni lavorativi sono successivi, ce c'è una R in mezzo interrompe la sequenza.

[Simo1]

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")           '<<< Le sigle che interrompono la sequenza lavorativa
pTitle = Array("C.T.", "Sorv.", "VVF", "CTvvf", "R.T.", "f.f.")      '<<< Le sigle dei lavoratori
tCol = 2                                   '<<< La colonna con le sigle, B=12
rDate = 14                                  '<<< La riga con le date
iCol = 4                                   '<<< La colonna di inizio, B=12
eCol = 10                                   '<<< 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 <= 10 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
Sub ccc()

aa = IsDate(Selection.Value)

End Sub

[Simo1]

questa e la worksheet in questione Anthony. Che tempo fa mi hai creato.

[Anthony47]

Eh, se ricordassi di che cosa stai parlando allora probabilmente sarei Mandrake...
Ti chiedo quindi "un aiutino", spiegando quale e' il contesto, quali sono i dati su cui lavorare e soprattutto per ottenere che cosa. E come sempre, se il tempo necessario per ricreare i tuoi dati e' superiore a 2 (due) minuti allora e' opportuno che condividi un tuo file dimostrativo.

Ciao

[Simo1]

Hehehehe già vero.... Anche perché è un lavoro di parecchi mesi fa.... In parole poveretto la macrobiotica era piu conplessa prxhe serve a far vedere quando si arriva al settimo giorno lavorato in un mese... Questa l'ho modificata e adatta per una srttimana sola... Il problema è che da lunedì a domenica se lavoro sei giorni di fila con un solo riposo giustamente mi colora le celle... Però se per caso mercoledì metto riposo ma lavoro tutti gli altri 6 giorni della settimana nn mi colora la cella perché R ossia riposo interrompe la sequenza. Vorrei in pratica che mi calcolasse i giorni cumulativi lavorati anche se spezzo la settimana con un riposo ed eventualmente se ci sono 2 riposi anche sfalsati dovrebbe risultare invece regolare senza nessuna colorazione. Dimmi se è capibile se no ti inoltro il file. In parole povere il riposo se messo a metà settimana o altro giorno non interrompa il conteggio dei giorni lavorati durante la settimana a meno che non siano 2 giorni di riposo.

[Simo1]

All'inizio della frase era "in parole povere la macro".... Compilatore automatico del telefono

[Anthony47]

Se la settimana va da Lunedi' a Domenica allora forse e' capibile, vedro' cosa posso fare...

[Simo1]

Ok grazie mille. perché è proprio il problema dell interruzione nella settimana con il riposo..... Poi dopo la sistemo io per le restanti settimane cambiando i parametri :-)

[Anthony47]

Ho trovato un vecchio file a cui si riferiva la Worksheet_Change che hai pubblicato; i dati avevano questo tracciato:
photo sharing

Mi pare che ora vorresti evidenziare eventuali situazioni di doppio riposo nell'arco della settimana.
Per questo ho modificato la Sub Worksheet_Change come segue:

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 And myC.Column > 1 Then
    I = myC.Row
'        Cells(I, 1).Interior.Color = xlNone
'        Cells(I, 1).Resize(1, 32).Font.Color = RGB(0, 0, 0)
        If Cells(I, 1) <> "" Then
            lwbound = Evaluate("Max(if(" & Range("A2").Resize(1, myC.Column).Address & "=""L"", Column(" & Range("A2").Resize(1, myC.Column).Address & "),""""))")
            rwbound = Evaluate("Min(if(" & Cells(2, myC.Column).Resize(1, 7).Address & "=""D"", Column(" & Cells(2, myC.Column).Resize(1, 7).Address & "),""""))")
            If lwbound = 0 Then lwbound = 2
            If rwbound = 0 Then rwbound = 32
            If Application.WorksheetFunction.CountIf(Range(Cells(myC.Row, lwbound), Cells(myC.Row, rwbound)), "R") > 1 Then
                Range(Cells(myC.Row, lwbound), Cells(myC.Row, rwbound)).Interior.Color = RGB(255, 0, 0)
            Else
                Range(Cells(myC.Row, lwbound), Cells(myC.Row, rwbound)).Interior.Color = xlNone
            End If
        End If
    End If
Next myC
End Sub


L'effetto sara' che, mentre introduci i turni, se nell'arco della stessa settimana vengono inseriti 2 o piu' R allora quella settimana verra' colorata in rosso; come vedi per il nominativo Due in figura
Per l'individuazione della "Settimana" (dal Lunedì alla Domenica) faccio affidamento sulle Lettere presenti in Riga2.

Ciao

[Simo1]

Mi sono espresso male in pratica sarebbe il contrario... Ossia se i turni nella settimana sono 5 con 2 riposi va tutto bene.... Se invece c'è solo un riposo allora scolora i turni ed evidenzia il nome... Come nella worksheets che ti ho girato.... Solo che quella interromperà la sequenza se il riposo era in mezzo alla settimana

[Anthony47]

Prima di fare una penultima versione avrei bisogno di capire come pensi di operare; cioe' quale e' il tuo processo e quali indicazioni vuoi ottenere a supporto.

Ciao

[Simo1]

Antony ho risolto, ho creato una formattazione condizionale tramite formula e poi l ho riportata nelle celle che mi servivano per tutto l anno. Grazie cmq....... Però volevo chiederti come fare per un altro problema al quale nn trovo soluzione... In pratica se tu guardi il foglio che mi hai inoltrato del MENSILE.... vorresti riportare i dati su un altro foglio diviso per settimane, ma in automatico compilando il foglio mensile tenendo conto però dei giorni della settimana in base agli anni.... Ossia se il 6 gennaio e lunedi quest'anno, l anno prossimo sarà mercoledì, per il foglio in automatico dovrà riportarmi i dati sul settimanale del lunedì. Ho provato a usare la formula indice-confronta ma mi da errore e nn mi fa funzionare la worksheet, anche se la integro con se.Errore

[Anthony47]

Continui a pensare che capisca al volo i tuoi quesiti, ma non e' cosi'... Quindi dovresti descrivere in dettaglio la domanda: almeno quali sono i dati di partenza e quali quelli di arrivo.
Ciao

[Simo1]

Nel file allegato, compilando il mensile in automatico dovrebbe compilare il settimanale, come da esempio, calcolando di anno in anno il cambiamento del lunedi, questo poi da adattare per le altre settimane, ma quello ci penso io, se riesci a darmi un imput per iniziare.
Grazie

[Simo1]

http://www.filedropper.com/prova1

[Anthony47]

Il "mensile" lo riconosco, il "settimanale" credo sia quello in colonna AM:AU
Pero' non ho capito come fai a mettere in un settimanale un mensile che di settimane ne ha piu' di una...
Supponiamo che la scelta si faccia indicando l'anno e il numero di settimana da prelevare; supponiamo che vengano scritti rispettivamente in AN7 (anno) e AO7 (n° settimana)
Allora metti questa formula in AO5, che ti dara' il primo giorno della settimana prescelta:

Codice: Seleziona tutto

=DATA(AN7;1;-2)-GIORNO.SETTIMANA(DATA(AN7;1;3))+AO7*7

In AP5 calcoli il giorno successivo con =AO5+1 e la copi verso destra

A questo punto puoi popolare la tabella sottostante usando Cerca.Orizz; es in AO9

Codice: Seleziona tutto

=CERCA.ORIZZ(AO$5;$D$1:$AH$40;RIF.RIGA(A1)+3;0)

Poi copi la formula verso destra e verso il basso

La formula ti restituira' "0" per le celle vuote nell'area mensile; se non ti piace lo risolvi con =Se(LaFormula=0;"";LaFormula)
La formula potrebbe restituire l'errore #N/D se la data non viene trovata nella riga delle date mensili; se non ti piace lo risolvi con =Se.Errore(LaFormula;"")

Questo inoltre presuppone che l'elenco dei nominativi (nominativi?) presente in AN9 e sottostanti sia esattamente la stessa che si trova in C4 e sottostanti

Ciao

[Simo1]

E avevo già provato anche con indice e confronta.... Il problema è che avendo delle formattazioni condizionali e delle macro automatiche.... La formula nelle celle nn mi fanno poi visula9il risultato delle macro... Non è possibile trasformare la formula in macro?

[Anthony47]

Immagino volessi dire che le macro distruggerebbero le formule della proposta che ti ho fatto...
Potrebbe quindi andare questa macro:

Codice: Seleziona tutto

Sub Settimana()
Dim Anno As String, Sett As String, WeSt As Date
Dim hMatch, vMatch, I As Longg, J As Long
'
Anno = "AN7"        '<<< La cella che contiene l' ANNO
Sett = "AO7"        '<<< La cella che contiene il num SETTIMANA
'
WeSt = DateSerial(Range(Anno).Value, 1, 1) + Range(Sett).Value * 7 - 7
WeSt = WeSt - Weekday(WeSt, vbMonday) + 1
For I = 9 To Cells(Rows.Count, "AN").End(xlUp).Row
    For J = 0 To 6
        Cells(5, "AO").Offset(0, J).Value = WeSt + J
        hMatch = Application.Match(CLng(WeSt) + J, Range("A1:AI1"), False)
        vMatch = Application.Match(Cells(I, "AN").Value, Range("C1:C100"), False)
        If Not IsError(hMatch) And Not IsError(vMatch) Then
            Cells(I, "AO").Offset(0, J).Value = Cells(vMatch, hMatch)
        Else
            Cells(I, "AO").Offset(0, J).ClearContents
        End If
    Next J
Next I
End Sub

Va messa in un Modulo standard del tuo progetto vba, poi al bisogno mandi in esecuzione la Sub Settimana

Presuppone che i nominativi contenuti nella colonna AN siano esattamente uguali a quelli riportati in colonna C

Ciao

[Simo1]

Nn funziona ..... AN7 e AO7 In realtà sul foglio non corrispondono a nulla solo a celle vuote... In pratica cosa dice la macro?

Avrei cmq ovviato il problema trasferendo la worksheet sul foglio del mensile... Potendo usare tranquillamente il cerca. Orizzontale sul foglio delle settimane.... Vorrei oltretutto adattare il cerca.Orizzontale al mensile inserendola nella formattazione condizionale dicendo che nella settimana dal lunedì al venerdì seguendo appunto la variazione degli anni spostandosi se rileva un solo "R" ossia riposo evidenzia il nome e il turno di rosso. Ho provato ad adattarlo inserendo all'interno della formula il conta. Se..... Che sto usando sul settimanale e funziona... Ma nel mensile avendo la variabile negli anni non riesco a trovare la quadra per farla funzionare :-/

[Anthony47]

Nn funziona ..... AN7 e AO7 In realtà sul foglio non corrispondono a nulla solo a celle vuote... In pratica cosa dice la macro?

L'ipotesi macro e' la continuazione di quanto dissi qualche messaggio fa:

Pero' non ho capito come fai a mettere in un settimanale un mensile che di settimane ne ha piu' di una...
Supponiamo che la scelta si faccia indicando l'anno e il numero di settimana da prelevare; supponiamo che vengano scritti rispettivamente in AN7 (anno) e AO7 (n° settimana)
Allora metti questa formula in AO5, che ti dara' etc etc etc