Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Pianificazione_Settimanale

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

Pianificazione_Settimanale

Postdi zsadist » 04/04/19 14:14

Buongiorno

vi espongo il mio quesito, spero nella maniera più chiara possibile

ogni settimana occorre pianificare la lavorazione di un tot di Addetti (di norma 11)
ogni addetto deve lavorare le pratiche di uno schedario, vi sono quindi dai 10 ai 15 schedari e ogni schedario contiene circa 10-12 pratiche.

questi schedari sono denominati con una lettera (A, B, C.. eccetera) o, al limite, con un codice di due cifre alfanumerico (ma non penso sia di rilevanza questo)

quindi, in condizioni normali, ogni addetto ha il suo schedario da seguire (Addetto 1: A, Addetto 2: B, e così via)


Il problema si pone con l’assenza di 1 o più Addetti

le pratiche di quell'Addetto o Addetti, devono essere suddivisi tra gli Addetti restanti, nei giorni lavorativi della settimana (settimana composta da 5 giorni, festività escluse ovviamente)


in questo momento, manualmente, si assegna quindi, ad esempio:

manca l'addetto 3, che si occupa dello schedario C
l'Addetto 1 (A) il lunedì si occuperà dello scaffale A + (C32) + (C41), il martedì si occuperà dello scaffale A + (C51) + (C60),...
l'Addetto 2 (B) il lunedì si occuperà dello scaffale B + (C34) + (C45), il martedì si occuperà dello scaffale A + (C54) + (C68),...

e così via...

è possibile creare una macro per automatizzare queste assegnazioni nelle giornate feriali per ogni addetto?

a quanto ho letto non posso inviare file, quindi, al limite, se qualcuno ne ha bisogno, posso inviare il file base (ovvero solo con delle formule e con la macro per la rilevazione della Pasqua)

Grazie a tutti in ogni caso
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Sponsor
 

Re: Pianificazione_Settimanale

Postdi zsadist » 04/04/19 14:31

zsadist ha scritto:Buongiorno

vi espongo il mio quesito, spero nella maniera più chiara possibile

ogni settimana occorre pianificare la lavorazione di un tot di Addetti (di norma 11)
ogni addetto deve lavorare le pratiche di uno schedario, vi sono quindi dai 10 ai 15 schedari e ogni schedario contiene circa 10-12 pratiche.

questi schedari sono denominati con una lettera (A, B, C.. eccetera) o, al limite, con un codice di due cifre alfanumerico (ma non penso sia di rilevanza questo)

quindi, in condizioni normali, ogni addetto ha il suo schedario da seguire (Addetto 1: A, Addetto 2: B, e così via)


Il problema si pone con l’assenza di 1 o più Addetti

le pratiche di quell'Addetto o Addetti, devono essere suddivisi tra gli Addetti restanti, nei giorni lavorativi della settimana (settimana composta da 5 giorni, festività escluse ovviamente)


in questo momento, manualmente, si assegna quindi, ad esempio:

manca l'addetto 3, che si occupa dello schedario C
l'Addetto 1 (A) il lunedì si occuperà dello scaffale A + (C32) + (C41), il martedì si occuperà dello scaffale A + (C51) + (C60),...
l'Addetto 2 (B) il lunedì si occuperà dello scaffale B + (C34) + (C45), il martedì si occuperà dello scaffale A + (C54) + (C68),...

e così via...

è possibile creare una macro per automatizzare queste assegnazioni nelle giornate feriali per ogni addetto?

a quanto ho letto non posso inviare file, quindi, al limite, se qualcuno ne ha bisogno, posso inviare il file base (ovvero solo con delle formule e con la macro per la rilevazione della Pasqua)

Grazie a tutti in ogni caso


mi correggo, ho visto ora come fare per caricare un file, vediamo se riesco
http://www.filedropper.com/pianificazionesettimanale
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: Pianificazione_Settimanale

Postdi Anthony47 » 05/04/19 01:39

manca l'addetto 3, che si occupa dello schedario C
l'Addetto 1 (A) il lunedì si occuperà dello scaffale A + (C32) + (C41), il martedì si occuperà dello scaffale A + (C51) + (C60),...
l'Addetto 2 (B) il lunedì si occuperà dello scaffale B + (C34) + (C45), il martedì si occuperà dello scaffale A + (C54) + (C68),...

e così via...
Non ho capito cosa intendi per "(C32)", "(C41)", "(C51)", "(C60)" e cosi' via.

Comunque secondo me in questi casi il lavoro che potrebbe essere svolto dal computer e' minimo rispetto a quello che viene richiesto al "capo", utilizzando regole scritte e non scritte, che cambiano di giorno in giorno.

Mi limito quindi a proporre un elaborato che, in funzione delle pratiche da sbrigare e delle risorse presenti, "smazza" il lavoro tra i presenti.
Partiamo dal demo file scaricabile qui:
https://www.dropbox.com/s/c6t78s8j34pm2 ... .xlsm?dl=0

Guardiamo il foglio Dati.

Da colonna I verso Destra sono posizionati gli Schedari; in riga 2 i "Nomi" e sottostanti mi immagino le sigle delle pratiche contenute (max 20 pratiche per schedario; max 20 schedari)
Questa parte va compilata

In B24 e sottostanti vanno elencate le Risorse disponibili; max 17 risorse
In A24 e sottostanti vengono elencati gli Schedari dichiarati prima, che si assumono accoppiati alla Risorsa adiacente

In C24 e sottostanti bisogna inserire, giorno dopo giorno, un 1 sulle risorse disponibili; per le risorse non disponibili la cella va lasciata vuota, ma puo' anche essere compilata con una Sigla (Ferie, Malattia, Boh,...)
A questo punto si puo' avviare la Sub WLoad(), che:
-esamina le risorse presenti e quelle assenti e calcola come "smazzare" il lavoro; per le "presenze" si guardera' l'ultima colonna compilata a destra dell'elenco Risorse (previsto max 25 colonne)
-a ogni risorsa assegna il relativo Schedario piu' un tot di pratiche degli schedari "orfani"
-colora su foglio Dati il lavoro assegnato a ogni risorsa con un colore diverso

Inoltre sul foglio Daily viene creato un riepilogo che contiene
-Nominativo, nome Schedario (se Schedario completo)
-Nominativo, nome Schedario, sigle delle pratiche assegnate (se ci sono pratiche "orfane" da suddividere)
Anche questo elenco viene colorato con colori diversi per ogni Risorsa, come fatto in foglio Dati.

Non so se puo' essere un punto di partenza per il lavoro da fare; da parte mia posso apportare piccole modifiche al file dimostrativo, oltre che commentare "un po' di più" il codice della macro.

Il codice di cui parliamo e' contenuto nel Modulo2 del vba, e corrisponde a questo listato:
Codice: Seleziona tutto
Dim ASched() As Integer, PrUnatt As Long, nMiss As Long, eXtra As Long, cArr

Sub WLoad()
Dim LastC As Long, Colleg As Range, myMatch
Dim cColl As Long, CollAv As Long, I As Long, rMan As Range
'
ReDim ASched(1 To Range("RISORSE").Rows.Count, 1 To 2)
cArr = Array(3, 4, 5, 6, 7, 8, 19, 20, 22, 24, 34, 35, 38, 39, 40, 43, 45, 46)
PrUnatt = 0: nMiss = 0
'
Sheets("Dati").Select
On Error Resume Next
Set rMan = Range("RISORSE")
Range("RISORSE").Interior.ColorIndex = xlNone
Range("SCHEDARI").Resize(20, 20).Interior.ColorIndex = xlNone
Sheets("Daily").Range("A2").Resize(10000, 25).Clear
'Cerca ultima colonna compilata con le presenze:
LastC = rMan.Resize(, 1000).Find(What:="*", _
    After:=rMan.Cells(1).Offset, _
    Lookat:=xlPart, LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
    MatchCase:=False).Column
On Error GoTo 0
'Calcola quali schedari /quante pratiche sono unattended:
For Each Colleg In rMan
    cColl = cColl + 1
    If Colleg <> "" And Colleg.Offset(0, -1) <> "" Then
        If Cells(Colleg.Row, LastC) <> 1 Then
            nMiss = nMiss + 1
            ASched(nMiss, 1) = cColl
            ASched(nMiss, 2) = Application.WorksheetFunction.CountA(Range("SCHEDARI").Offset(1, cColl - 1).Resize(20, 1))
            PrUnatt = PrUnatt + ASched(nMiss, 2)
        Else
            If Cells(Colleg.Row, LastC) = 1 Then CollAv = CollAv + 1
        End If
    End If
Next Colleg
eXtra = Application.WorksheetFunction.RoundUp(PrUnatt / CollAv, 0)
'
'Assegna a ogni Risorsa
For I = 1 To rMan.Rows.Count
    If rMan.Cells(I, LastC - 1) = 1 Then
        Range(Range("SCHEDARI").Offset(0, I - 1), Range("SCHEDARI").Offset(0, I - 1).End(xlDown)).Interior.ColorIndex = cArr(I - 1)
        rMan.Cells(I, 1).Interior.ColorIndex = cArr(I - 1)
        Sheets("Daily").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Range("RISORSE").Cells(I, 1)
        Sheets("Daily").Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = Range("RISORSE").Cells(I, 1).Offset(0, -1)
        Sheets("Daily").Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Interior.ColorIndex = cArr(I - 1)
        Call GeXtra(I)
    End If
Next I
End Sub


Sub GeXtra(LI As Long)
Dim CASch As Long, iASch As Long, cXtra As Long, dNext As Long
    For I = 1 To nMiss
        For j = 1 To ASched(I, 2)
            If Range("SCHEDARI").Cells(j + 1, ASched(I, 1)).Interior.ColorIndex = xlNone Then
                Range("SCHEDARI").Cells(j + 1, ASched(I, 1)).Interior.ColorIndex = cArr(LI - 1)
                cXtra = cXtra + 1
                dNext = Sheets("daily").Cells(Rows.Count, 1).End(xlUp).Row
                If cXtra = 1 Then dNext = dNext + 1
                Sheets("Daily").Cells(dNext, 1) = Range("RISORSE").Cells(LI, 1)
                Sheets("Daily").Cells(dNext, 2) = Range("SCHEDARI").Cells(1, ASched(I, 1))
                Sheets("Daily").Cells(dNext, 2 + cXtra) = Range("SCHEDARI").Cells(j + 1, ASched(I, 1))
                Sheets("Daily").Cells(dNext, 1).Resize(1, cXtra + 2).Interior.ColorIndex = cArr(LI - 1)
                If cXtra >= eXtra Then Exit Sub
            End If
        Next j
    Next I
End Sub

Spero sia di qualche utilita'...
Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17442
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Pianificazione_Settimanale

Postdi zsadist » 05/04/19 08:44

Buongiorno
all'anima.. si, minimizzando si potrebbe dire che mi è di qualche utilità.. insomma.. sei un Grande

Anthony47 ha scritto:Non ho capito cosa intendi per "(C32)", "(C41)", "(C51)", "(C60)" e cosi' via.


Ti dirò.. non ho capito perchè il "Capo" si ostini su questo, dato che ogni pratica ha un codice univoco, comunque, la C dell'esempio significa Schedario C e a fianco il numero di pratica (tu in DAILY hai messo, giustamente, solo il numero di pratica, che è la cosa più logica), secondo lui, questo riduce i tempi per cercare la pratica: Vi è scritto lo schedario, quindi non deve guardare la lista degli schedari e il contenuto.... vabbè..


Anthony47 ha scritto:Comunque secondo me in questi casi il lavoro che potrebbe essere svolto dal computer e' minimo rispetto a quello che viene richiesto al "capo", utilizzando regole scritte e non scritte, che cambiano di giorno in giorno.


concordo con te..

Anthony47 ha scritto:Mi limito quindi a proporre un elaborato che, in funzione delle pratiche da sbrigare e delle risorse presenti, "smazza" il lavoro tra i presenti.
........
Guardiamo il foglio Dati.

Da colonna I verso Destra sono posizionati gli Schedari; in riga 2 i "Nomi" e sottostanti mi immagino le sigle delle pratiche contenute (max 20 pratiche per schedario; max 20 schedari)
Questa parte va compilata

In B24 e sottostanti vanno elencate le Risorse disponibili; max 17 risorse
In A24 e sottostanti vengono elencati gli Schedari dichiarati prima, che si assumono accoppiati alla Risorsa adiacente

In C24 e sottostanti bisogna inserire, giorno dopo giorno, un 1 sulle risorse disponibili; per le risorse non disponibili la cella va lasciata vuota, ma puo' anche essere compilata con una Sigla (Ferie, Malattia, Boh,...)
A questo punto si puo' avviare la Sub WLoad(), che:
-esamina le risorse presenti e quelle assenti e calcola come "smazzare" il lavoro; per le "presenze" si guardera' l'ultima colonna compilata a destra dell'elenco Risorse (previsto max 25 colonne)
-a ogni risorsa assegna il relativo Schedario piu' un tot di pratiche degli schedari "orfani"
-colora su foglio Dati il lavoro assegnato a ogni risorsa con un colore diverso

Inoltre sul foglio Daily viene creato un riepilogo che contiene
-Nominativo, nome Schedario (se Schedario completo)
-Nominativo, nome Schedario, sigle delle pratiche assegnate (se ci sono pratiche "orfane" da suddividere)
Anche questo elenco viene colorato con colori diversi per ogni Risorsa, come fatto in foglio Dati.


il lavoro, a mio parere, è eccezionale..
le mie poche conoscenze di VBA impattano contro la melodia che il tuo codice sembra esprimere


Anthony47 ha scritto:Non so se puo' essere un punto di partenza per il lavoro da fare; da parte mia posso apportare piccole modifiche al file dimostrativo, oltre che commentare "un po' di più" il codice della macro.


ora cerco di anticiparti ciò che mi verrà contestato:
premessa..
il file che avevo allegato, come avrai ben visto, era un semplice file di controllo presenze giornaliero per ogni addetto.
lo avevo fatto proprio per facilitare ciò che il "capo" doveva fare: se vi erano festività, le celle si coloravano di rosso e lui sapeva che non doveva scrivere nulla, se una cella, relativa ad un addetto, era grigia, esso era Assente..
dato che lui compila il prospetto ad inizio settimana (hai scritto giorno dopo giorno.. ma che siamo matti? tutto questo lavoro giornaliero??) aveva una chiara visione delle assenze.
nella scheda "DATI", infatti, si compilava con le ferie programmate (così evita anche di andare a riguardarle Giorno per giorno.. le inserisce una volta e poi si asciuga il sudore), con due caselle "DAl - Al", per tre programmazioni "Lunghe".. altre 5 programmazioni lunghe per eventuali Ferie, Malattie, eccetera, che potrebbero includere assenze composte da più giorni, anche per mesi che non riguardano quello del mese in cui si sta lavorando (insomma, se già compila per Lucia le ferie di luglio, non dovrà poi ricordarsi di inserirle).
poi 5 giorni singoli, relativi alla settimana in esame, per eventuali assenze.. non previste.

lo so, ho fatto uno schifo di lavoro.. mi piacerebbe saperci lavorare.. ma.. madre natura ha atteso che andassi in bagno per distribuire i cervelli..

comunque..

premesso questo, Lui, ad inizio settimana, compila la pianificazione che avrà un aspetto simile:

Immagine

per ogni riga dell'addetto, vi sono le 4 righe precedenti che ho usato per gestire assenze o festività

Immagine

ovviamente, l'1 mi dice che vi è una festività o un'assenza per la giornata, per ogni Addetto.. chissà, poteva servire per il codice? non so..

allora.. da ciò, dicevo, posso immaginare le sue obiezioni: non vuole compilare giorno per giorno le assenze!! il resto viene da se..

quindi.. è fattibile modificare il codice affinchè esegua le assegnazioni basandosi sulle assenze programmate? cioè su più giorni di assenza e per più Addetti, suddivisi nella settimana?
inoltre, è possibile modificare il DAILY, in modo che non vada a scrivere su diverse celle il numero delle pratiche, ma lo scriva in unica riga nella cella del giorno?

come puoi vedere dalla prima immagine, se manca un addetto, gli altri addetti prendono in carico le sue pratiche, avranno, per i giorni mancanti, sempre le stesse pratiche da lavorare (se Marta manca per 3 giorni, Schedario G, Diego, che si occupa dello scaffale H, sarà uno di quelli che avrà le sue pratiche e lavorerà per i 3 giorni sempre le pratiche H +(G)4899 +(G)4900)

so che sto esagerando nelle richieste, e naturalmente sei autorizzato a mandarmi a quel paese..

io ti prometto che cercherò di studiare e capire il tuo codice e provare a modificare in modo da ottenere una cosa simile a quella che ho richiesto..

intanto, ti ringrazio di cuore per quello che hai fatto.. e, in caso tu non possa fare altro, la mia stima non cambia.. anzi..
al limite ti romperò con qualche domanda man mano che faccio le modifiche..

grazie di cuore
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: Pianificazione_Settimanale

Postdi zsadist » 05/04/19 10:00

che scemo che sono.. il tutto per 5
ok, provo...
una sola domanda..
hai detto massimo 17 addetti.. vi è un motivo particolare o si tratta di modificare il range di RISORSE?
solo una curiosità..

grazie.. grazie davvero
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: Pianificazione_Settimanale

Postdi Anthony47 » 06/04/19 01:41

Azz, siete la prima organizzazione che al lunedi' sa' gia' chi sara' malato il mercoledi'...
Comunque mi dispiace, ma non mi cimento in una "versione 2.0".
Bisognerebbe immergersi nel workflow del vostro ufficio per proporre qualcosa, e non semplicemente fare in modo diverso le stesse cose che fate ora.

Il 17 nasce dal fatto che volendo individuare il lavoro di ogni risorsa anche con un colone, nella palette di colori ho individuato solo 17 colori identificabili abbastanza nettamente.
Per estendere le risorse quindi devi:
-allungare l'intervallo risorse (aggiungi altre righe all'interno dell'attuale elenco, non in coda)
-identificare altri colori utilizzabili per marcare il lavoro di queste nuove risorse potenziali, e aggiungere il loro codice all'interno della riga
cArr = Array(3, 4, 5, 6, 7, 8, 19, 20, 22, 24, 34, 35, 38, 39, 40, 43, 45, 46)

Per visualizzare tutti i 56 colori utilizzabili da excel puoi sfruttare la Sub AllColors presente in Modulo2; questa visualizzera' in colonna K di foglio Daily i colori e accanto il loro codice; cerca colori utilizzabili, che non siano gia' presenti all'interno di cArr, e aggiungili in coda a quelli attuali.

Per stampare solo i colori presenti in cArr puoi usare la Sub ShowColors, sempre in Modulo2

cArr deve contenere almeno tanti codici quante sono le potenziali risorse.
Per la prima risorsa in elenco di usera' il primo codice colore presnte in cArr; per la seconda risorsa, il secondo colore; e cosi' via.

Comunque propongo una versione 1.b, scaricabile a questo indirizzo:
https://www.dropbox.com/s/xy6600pr7hewo ... .xlsm?dl=0

Rispetto a quanto gia' proposto, ho inserito fino a 20 risorse (ma i colori che ho aggiunto in cArr li ho scelti a caso, quindi non garantisco che siano differenti come tonalita' rispetto ai colori gia' presenti); ho previsto che si possa lavorare a settimana (le presenza vanno inserite nelle colonne C:G accanto ai nominativi; l'intestazione viene "ereditata" da cella F4, Inizio Settimana); vengono create 5 programmazioni, nei fogli DAILY_x (dove x varia da 1=Lun a 5=Ven)

PERO' la struttura logica rimane la stessa della prima versione.

Le modifiche sono state marginali sulla Sub WLoad e sulla Sub GeXtra (le macro precedenti), pero' ho aggiunto una Sub WWLoad che e' quella da lanciare e che si preoccupera' di avviare la Sub WLoad.
Codice: Seleziona tutto
Sub WWLoad()
'Versione Weekly
For I = 1 To 5
    Call WLoad(I)
Next I
MsgBox ("Programmazione Settimanale completata")
End Sub


che scemo che sono.. il tutto per 5
Questa non sono riuscita a decodificarla, spero non fosse invece fondamentale.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17442
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Pianificazione_Settimanale

Postdi zsadist » 06/04/19 09:14

Come detto sei un grande..
No.. non è che si sappia prima se uno, durante la settimana, si mette in malattia, però se qualcuno ha una malattia lunga, piuttosto che un continuo di malattia, questo aiuta il capo a pianificare :)

Ora sono fuori sede fino a martedì, poi riuscirò a vedere quanto mi hai detto, ma.. con la frase "che scemo che sono, il tutto per 5", intendevo proprio una routine tipo quella che hai inserito, se ho capito bene cosa sia... grazie ancora.. ti farò sapere :)
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48

Re: Pianificazione_Settimanale

Postdi zsadist » 09/04/19 15:02

Anthony47 ha scritto:Azz,....... ecc ecc

Il 17 nasce dal fatto che volendo individuare il lavoro di ogni risorsa anche con un colone, nella palette di colori ho individuato solo 17 colori identificabili abbastanza nettamente.
Per estendere le risorse quindi devi:
-allungare l'intervallo risorse (aggiungi altre righe all'interno dell'attuale elenco, non in coda)
-identificare altri colori utilizzabili per marcare il lavoro di queste nuove risorse potenziali, e aggiungere il loro codice all'interno della riga
cArr = Array(3, 4, 5, 6, 7, 8, 19, 20, 22, 24, 34, 35, 38, 39, 40, 43, 45, 46)

Per visualizzare tutti i 56 colori utilizzabili da excel puoi sfruttare la Sub AllColors presente in Modulo2; questa visualizzera' in colonna K di foglio Daily i colori e accanto il loro codice; cerca colori utilizzabili, che non siano gia' presenti all'interno di cArr, e aggiungili in coda a quelli attuali.

Per stampare solo i colori presenti in cArr puoi usare la Sub ShowColors, sempre in Modulo2

cArr deve contenere almeno tanti codici quante sono le potenziali risorse.
Per la prima risorsa in elenco di usera' il primo codice colore presnte in cArr; per la seconda risorsa, il secondo colore; e cosi' via.

Comunque propongo una versione 1.b, scaricabile a questo indirizzo:
https://www.dropbox.com/s/xy6600pr7hewo ... .xlsm?dl=0

......ecc ecc ecc

Ciao



Ciao
allora, ti confesso che ho voluto provare io me medesimo da solo a fare qualcosa..
senza togliere nulla a te, ma dovrò imparare prima o poi no? :D

ho modificato il codice Wload e GeXtra affinchè, al posto di Daily, mi utilizzasse Prospetto per visualizzare la pianificazione.

è ancora in fase di bozza, ma sembra funzioni :)

ovvio, ho ancora da lavorare per "ripulirlo" ed effettuare il controllo errori, ma almeno sono ad un buon punto di partenza (grazie a te)
ho voluto lasciare il controllo delle celle colorate per le pratiche, davvero un bel sistema per vedere quale è stata "lavorata" dalla routine e quale no!!

Codice: Seleziona tutto
Sub WLoad1()
'******************************************************
'* Codici Originali a cura di Anthony47               *
'*                                                    *
'* Rileva i giorni non festivi da Prospetto           *
'* Rileva gli Addetti presenti nella settimana        *
'* Rileva la colonna dello Schedario degli Assenti    *
'* Assegna le pratiche degli assenti tra gli          *
'* Addetti presenti                                   *
'* Segna il tutto su Prospetto                        *
'*                                                    *
'******************************************************


Dim LastC As Long, Colleg As Range, myMatch
Dim cColl As Long, CollAv As Long, i As Long, o As Long, rMan As Range
Dim Gh, Jk, Ht As Integer

'
Set wk1 = ThisWorkbook
    Set Dati = wk1.Worksheets("Impostazioni")
    Set Prosp = wk1.Worksheets("Prospetto")
   
Cot = "1234abcd"

ActiveSheet.Unprotect (Cot)

ReDim ASched(1 To Range("Addetti").Rows.Count, 1 To 2)
cArr = Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 20, 22, 24, 34, 35, 38, 39, 40, 43, 45, 46)
PrUnatt = 0: nMiss = 0
'
Dati.Select
x = Dati.Range("AL2").End(xlToLeft).Column
x = colonna(x + 0)


' ****** Pulisce Prospetto ******* OK
For Gh = 11 To 76 '91
Prosp.Range("D" & Gh & ":H" & Gh).ClearContents
Gh = Gh + 4
Next Gh

On Error Resume Next
Set rMan = Range("Addetti") 'dichiaro il range Addetti
'Range("Addetti").Interior.ColorIndex = xlNone 'tolgo i colori da Addetti"
Range("Raccolta").Resize(20, 20).Interior.ColorIndex = xlNone 'e li tolgo dalla raccolta


On Error GoTo 0

For Jk = 4 To 8

If Prosp.Cells(8, Jk) = 1 Then GoTo ProssGio Else
Range("Raccolta").Resize(20, 20).Interior.ColorIndex = xlNone
NriS = Range("B50").End(xlUp).Row
cColl = 0
nMiss = 0
For Ht = 27 To NriS
RRis = Cells(Ht, 27)
RAss = RRis - 4
cColl = cColl + 1

If Prosp.Cells(RAss, Jk) = 1 Then
            IDg = Prosp.Cells(RRis, 3)
            nMiss = nMiss + 1
                Set zonac = Dati.Range("I2:" & x & "2") 'trovato l'assente, trovo la sua lista di pratiche, o gruppo
               
                If IDg = "" Then GoTo FineEformatta
                For Each CL In zonac
                If CL.Value = IDg Then
                CL.Select
                Ro = CL.Column
                Cro = colonna(Ro + 0)
                GoTo trovataID
                End If
FineEformatta:
            Next
trovataID:
            ASched(nMiss, 1) = Ro 'cColl
           
            ASched(nMiss, 2) = Application.WorksheetFunction.CountA(Range(Cro & "3:" & Cro & "20"))
            PrUnatt = PrUnatt + ASched(nMiss, 2)
        Else
            If Prosp.Cells(RAss, Jk) = 0 Then CollAv = CollAv + 1
        End If

Next Ht
eXtra = Application.WorksheetFunction.RoundUp(PrUnatt / CollAv, 0) '.. Round O roundUP? devo effettuare il giusto calcolo per la suddivisione

'Assegna a ogni Risorsa
o = 0
For i = 27 To NriS
o = i - 26
Tito = ""
RRis = Cells(i, 27)
RAss = RRis - 4
   
    If Prosp.Cells(RAss, Jk) = 0 Then
        Range(Range("Raccolta").Offset(0, o - 1), Range("Raccolta").Offset(0, o - 1).End(xlDown)).Interior.ColorIndex = cArr(o - 1)

       Tito = Prosp.Cells(RRis, 3)
        Call GeXtra1(o)
      Prosp.Cells(RRis, Jk) = Tito
    End If
Next i
ProssGio:
Next Jk

Range("Raccolta").Resize(20, 20).Interior.ColorIndex = xlNone

ActiveSheet.Protect Password:=Cot, DrawingObjects:=True, Contents:=True, Scenarios:=True

Prosp.Select

End Sub


mi sono voluto assicurare, anche, che lo schedario venga cercato nella raccolta.. insomma.. lo so, è molto grezzo e da sistemare, ma ci lavorererò

Codice: Seleziona tutto
Sub GeXtra1(LI As Long)
Dim CASch As Long, iASch As Long, cXtra As Long, dNext As Long
    For i = 1 To nMiss
        For j = 1 To ASched(i, 2)

       

            If Dati.Cells(j + 2, ASched(i, 1)).Interior.ColorIndex = xlNone Then
                Dati.Cells(j + 2, ASched(i, 1)).Interior.ColorIndex = cArr(LI - 1)
                cXtra = cXtra + 1
               Tito = Tito & " + (" & Dati.Cells(2, ASched(i, 1)) & ")"
               Tito = Tito & Dati.Cells(j + 2, ASched(i, 1))

                If cXtra >= eXtra Then Exit Sub
            End If
        Next j
    Next i
End Sub


grazie ancora :) :)
Adattati! L'incapacità di cambiare direzione porta alla sconfitta
zsadist
Utente Junior
 
Post: 96
Iscritto il: 04/04/19 13:48


Torna a Applicazioni Office Windows

Chi c’è in linea

Visitano il forum: Nessuno e 47 ospiti