Condividi:        

Adattare Worksheet

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

Adattare Worksheet

Postdi Simo1 » 22/05/20 21:42

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
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Sponsor
 

Re: Adattare Worksheet

Postdi Simo1 » 22/05/20 21:43

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
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Simo1 » 22/05/20 21:45

questa e la worksheet in questione Anthony. Che tempo fa mi hai creato.
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 22/05/20 23:33

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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 23/05/20 13:25

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
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Simo1 » 23/05/20 14:06

All'inizio della frase era "in parole povere la macro".... Compilatore automatico del telefono
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 23/05/20 15:23

Se la settimana va da Lunedi' a Domenica allora forse e' capibile, vedro' cosa posso fare...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 23/05/20 16:06

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 :-)
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 24/05/20 11:59

Ho trovato un vecchio file a cui si riferiva la Worksheet_Change che hai pubblicato; i dati avevano questo tracciato:
Immaginephoto 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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 24/05/20 12:25

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
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 25/05/20 10:50

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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 25/05/20 18:03

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
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 26/05/20 00:36

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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 27/05/20 20:49

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
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Simo1 » 27/05/20 20:52

Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 28/05/20 00:59

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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 28/05/20 15:19

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?
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 29/05/20 00:13

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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Adattare Worksheet

Postdi Simo1 » 29/05/20 19:31

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 :-/
Simo1
Utente Junior
 
Post: 75
Iscritto il: 21/11/18 08:41

Re: Adattare Worksheet

Postdi Anthony47 » 29/05/20 20:22

Somo1 ha scritto: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:
Anthony qualche messaggio fa ha scritto: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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Adattare Worksheet":


Chi c’è in linea

Visitano il forum: Nessuno e 34 ospiti