Excel - Modfica macro di Flash30005

[Sasyjoe]

Ciao a tutti,
in particolare a flash

Avrei bisogno di modificare una macro che mi creasti qualche mese fa sui turni.
la macro è la seguente:

Codice: Seleziona tutto

Sub PrgTurni()
strPassword = ""
ActiveSheet.Unprotect Password:=strPassword
NomeF = ActiveSheet.Name
Set Ws1 = Worksheets(NomeF)
UCT = Ws1.Range("IV2").End(xlToLeft).Column
URT = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Rep = ""
Ws1.Range("B14:O53").Interior.ColorIndex = xlNone
        For RRT = 14 To 53
            For CCT = 2 To UCT
                If UCase(Ws1.Cells(RRT, CCT).Value) <> "NO" Then
                Ws1.Cells(RRT, CCT).ClearContents
                End If
            Next CCT
        Next RRT
For ColT = 2 To UCT
Turno = "10-15"
If ColT Mod 2 = 1 Then Turno = "15-20"
For RRL = 5 To 9
Select Case RRL
Case 5
Colore = 6
Rep = "a"
Case 6
Colore = 50
Rep = "b"
Case 7
Colore = 41
Rep = "c"
Case 8
Colore = 15
Rep = "d"
Case 9
Colore = 8
Rep = "e"
End Select
NumP = Ws1.Cells(RRL, ColT).Value
    For RT = 1 To NumP
        If RT = 1 Then
            If Ws1.Cells(RRL + 9, ColT).Value = "" Then
                Ws1.Cells(RRL + 9, ColT).Value = Turno & Rep
                Ws1.Cells(RRL + 9, ColT).Interior.ColorIndex = Colore
            Else
                Ws1.Cells(RRL + 14, ColT).Value = Turno & Rep
                Ws1.Cells(RRL + 14, ColT).Interior.ColorIndex = Colore
            End If
        Else
Ripr:
            RCas = Int(Rnd(30) * 30) + 24
            If UCase(Mid(Ws1.Cells(RCas, 1).Value, 1, 4)) <> "COLL" Then GoTo Ripr
            MyC = Evaluate("=Min(" & NomeF & "!P24:P" & URT & ")")
            If Ws1.Cells(RCas, 16).Value <> MyC Or Ws1.Cells(RCas, ColT).Value <> "" Then GoTo Ripr
            If Turno = 2 And Ws1.Cells(RCas, ColT - 1).Value <> "" And UCase(Ws1.Cells(RCas, ColT - 1).Value) <> "NO" Then GoTo Ripr
            Ws1.Cells(RCas, ColT).Value = Turno & Rep
            Ws1.Cells(RCas, ColT).Interior.ColorIndex = Colore
        End If
    Next RT
Next RRL
Next ColT
ActiveSheet.Protect Password:=strPassword
End Sub

Avrei bisogno di due cose:

1)
che la macro in caso di bisogno da il turno sia 10-15 che 15-20 alla stessa persona.
Attualmente la macro si blocca quando le richieste di mattina + quelle del pomeriggio sono > del numero collaboratori disponibili.
Attenzione a questo passaggio:
Le richieste attualmente sono maggiori del numero collaboratori disponibili perchè la macro non assegna allo stesso collaboratore il turno sia di mattina che di pomeriggio. (Quindi anche se il collaboratore di pomeriggio è disponibile, la macro non gli assegna il turno e si blocca)
Ho pensato che forse questo accade perchè vuole distribuire in maniera uniforme i turni a tutti i collaboratori.
Se il problema è questo, puoi anche disabilitare questa funzione, l'importante è che non si blocca la macro.


2)
Non far bloccare la macro.
Quando si blocca la macro, devo chiudere Excel e ricominciare tutto d'accapo inserendo dinuovo le non disponibilità e le impostazioni.


Grazie a tutti.

EDIT Flash30005 - Inserito Tag sul codice macro: è opportuno inserire sempre i Tag dell'editor in questo caso "Code" per codici macro.

[Flash30005]

Non ho un esempio pratico di richieste maggiori del numero di collaboratori
o invii il file con queste condizioni oppure indicami come posso modificare quello in mio possesso per ottenere questa situazione

inoltre sapere come assegnare il secondo turno (al primo in lista)?

ciao

[Sasyjoe]

Appena posso allego file.

Grazie

[Sasyjoe]

Flash ce un modo per caricare il file e lo vedi solo tu?

[Flash30005]

Usa un MP
nell'MP inserirai il link del server host

[Sasyjoe]

Flash vedi posta privata.

Grazie

[Sasyjoe]

Flash posta personale.


ciao

[Flash30005]

Le richieste attualmente sono maggiori del numero collaboratori disponibili perchè la macro non assegna allo stesso collaboratore il turno sia di mattina che di pomeriggio. (Quindi anche se il collaboratore di pomeriggio è disponibile, la macro non gli assegna il turno e si blocca)

Non mi risulta

che la macro in caso di bisogno da il turno sia 10-15 che 15-20 alla stessa persona.
Attualmente la macro si blocca quando le richieste di mattina + quelle del pomeriggio sono > del numero collaboratori disponibili

Ho eliminato del personale (ultime righe) per far sì che le richieste (Matt + Pom) fossero maggiori delle disposizioni,
ho avviato la macro e non riscontro il problema

(Quindi anche se il collaboratore di pomeriggio è disponibile, la macro non gli assegna il turno e si blocca)

"Quindi" suppongo sia una tua deduzione che reputo errata.

2)
Non far bloccare la macro.
Quando si blocca la macro, devo chiudere Excel e ricominciare tutto d'accapo inserendo dinuovo le non disponibilità e le impostazioni.

Questo forse dipenderà dal tuo file nel quale hai aggiunto altre 200 righe composte da formule (che non visualizzano nulla e tabelle varie)
Scusami ma devo dire che non ho mai visto un foglio (utilizzato per lavoro) così caotico e mi meraviglio per il fatto che tu abbia modificato così radicalmente un foglio che viene processato da una macro della quale conosci (così sembra) ben poco

Ti invio di nuovo il file originale al quale, come detto, ho tolto (portato fuori dal range) del personale (Coll..)
Download file

Vedrai che fa tutto ciò che richiedi e non si blocca.

Ciao

P.s. Per capire l'inghippo ho perso circa un paio d'ore che avrei risparmiato se mi avessi detto subito di aver modificato il foglio

[Sasyjoe]

Flash dal file che mi hai postato,
ti invito a mettere "no" dalla cella N24:N32

Le richieste di domenica mattina sono 18.
Meno 5 dei responsabili.
Le richieste sono 13 collaboratori.
Mettendo no da N24 ad N32 ho 13 collaboratori disponibili.
La macro si blocca.

Puoi non farla bloccare?
Mi esce il simbolo della clessidra e resta cosi fin quando non lo chiudo manualmente.

Il problema o è il file o il mio pc!!

Ciao

[Flash30005]

E' vero!
è una condizione "estrema"
assegnare tutti no alla fine della settimana a 9 lavoratori e lasciarne 13 liberi (il minimo indispensabile)
considerando che i turni dall'inizio settimana sono casuali, la macro potrebbe non assegnare turni ad uno o più lavoratori-no
pertanto mancano i turni da fare e la macro "stalla".

Dovrei reimpostare l'intera macro
ma qui occorrono altre informazioni perché stando alla logica se un dipendente ha giorni non lavorativi nell'arco della settimana
la macro dovrà forzare a fare più turni quando è disponibile (?)
Insomma diventa un bel problema, speriamo di riuscire a trovare il tempo per dedicarmici.

Mi domando: nella realtà succede anche questo?
(per tutte le prove fatte finora non mi è capitata questa situazione

ciao

[Sasyjoe]

Se ti posto io il codice di come vorrei i turni, puoi poi aggiungere la funzione casuale della distribuzione e che non assegna il turno se in quella cella ce il "no"?

Secondo me per risolvere la problematica (mia intuizione forse sbagliata), e quindi non far bloccare la macro, bisogna eliminare la funzione che distribuisce le ore in maniera equilibrata cioè tutti i collaboratori hanno piu o meno le stesse ore.

a me questo non serve.

Voglio solo che la macro non si blocca mai e che se le richieste sono maggiori della disponibilità le inserisce nel rigo di sotto e poi vedo io come organizzarmi.

Ma quando si blocca devo ricominciare sempre tutto d'accapo..

Ti posto il codice mio?

ciao

[Flash30005]

Se ti posto io il codice di come vorrei i turni,

Ma se hai il codice inseriscilo nella macro e hai risolto!

Ho rilevato che non esiste il filtro turni
esiste una riga codice che non funziona mai: forse un refuso non aggiornato o non modificato, di una versione-test precedente,
altrimenti non noteresti i doppi turni nel file inviato mentre essi ci sono.

Credo che il massimo che possa fare, senza stravolgere, con possibilità di compromettere l'attuale funzionamento (che a parte questa particolare situazione, è eccellente),
è assegnare i turni a coprire l'intera richiesta ma il personale non potrà mai essere inferiore ad essa
nel caso fosse così potrei far apparire un messaggio con il quale avrai la possibilità di annullare l'operazione.
Non potrei assegnare un turno ad una o più righe-dipendenti se i dipendenti non ci sono.

Ciao

[Flash30005]

Non ho ricevuto alcuna altra specifica
ma ho provveduto in questa maniera

Codice: Seleziona tutto

Sub PrgTurni()
NomeF = ActiveSheet.Name
Set Ws1 = Worksheets(NomeF)
UCT = Ws1.Range("IV2").End(xlToLeft).Column
URT = Ws1.Range("A54").End(xlUp).Row
For RRT = 24 To URT
RigaC = RRT
If UCase(Mid(Ws1.Range("A" & RRT).Value, 1, 4)) <> "COLL" Or UCase(Right(Ws1.Range("A" & RRT).Value, 1)) = "X" Then Exit For
Next RRT
NC = RigaC - 23
Rep = ""
Ws1.Range("B14:O53").Interior.ColorIndex = xlNone
        For RRT = 14 To 53
            For CCT = 2 To UCT
                If UCase(Ws1.Cells(RRT, CCT).Value) <> "NO" Then
                Ws1.Cells(RRT, CCT).ClearContents
                End If
            Next CCT
        Next RRT
For ColT = 2 To UCT
Turno = "10-15"
Contaex = 0
If ColT Mod 2 = 1 Then Turno = "15-20"
For RRL = 5 To 9
Select Case RRL
Case 5
Colore = 6
Rep = "A"
Case 6
Colore = 50
Rep = "B"
Case 7
Colore = 41
Rep = "C"
Case 8
Colore = 15
Rep = "D"
Case 9
Colore = 8
Rep = "E"
End Select
NumP = Ws1.Cells(RRL, ColT).Value
    For RT = 1 To NumP
        If RT = 1 Then
            If Ws1.Cells(RRL + 9, ColT).Value = "" Then
                Ws1.Cells(RRL + 9, ColT).Value = Turno & Rep
                Ws1.Cells(RRL + 9, ColT).Interior.ColorIndex = Colore
            Else
                Ws1.Cells(RRL + 14, ColT).Value = Turno & Rep
                Ws1.Cells(RRL + 14, ColT).Interior.ColorIndex = Colore
            End If
        Else
            MyCNo = 0
            For RRC = 24 To RigaC
                If UCase(Cells(RRC, ColT).Value) = "NO" Then
                    MyCNo = MyCNo + 1
                End If
            Next RRC
            ST = 0
            For RRT = 5 To 9
                ST = ST + Cells(RRT, ColT).Value
            Next RRT
            If NC - MyCNo <= ST - 5 Then
RiprEx:

                If NC - MyCNo < ST - 5 Then
                    If Contaex >= NC - MyCNo Then
                    AggG = "eriggio"
                    If Ws1.Cells(4, ColT).Value = "Matt" Then AggG = "ina"
                        URC = Ws1.Range("A54").End(xlUp).Row + 1
                        Msg = Application.Proper(Format(Ws1.Cells(3, ColT).Value, "dddd") & " " & Ws1.Cells(4, ColT).Value & AggG) & vbCrLf
                        Msg = Msg & "Turnisti disponibili inferiori ai turni effettivi: " & vbCrLf
                        Msg = Msg & "Il turno sarà accodato"
                        MsgBox Msg
                        Ws1.Cells(URC, ColT).Value = Turno & Rep
                        Ws1.Cells(URC, ColT).Interior.ColorIndex = Colore
                        Contaex = Contaex + 1
                        GoTo SaltaRT
                    End If
                End If
                Rcas = Int(Rnd(NC) * NC) + 24
                If Ws1.Cells(Rcas, ColT).Value <> "" Then GoTo RiprEx
                Ws1.Cells(Rcas, ColT).Value = Turno & Rep
                Ws1.Cells(Rcas, ColT).Interior.ColorIndex = Colore
                Contaex = Contaex + 1

            Else

Ripr:
                Rcas = Int(Rnd(NC) * NC) + 24
                MyC = Evaluate("=Min(" & NomeF & "!P24:P" & RigaC & ")")
                If Ws1.Cells(Rcas, ColT).Value <> "" Then GoTo Ripr
                If Ws1.Cells(Rcas, 16).Value <> MyC Then GoTo Ripr
                If Turno = 2 And Ws1.Cells(Rcas, ColT - 1).Value <> "" Then GoTo Ripr
                Ws1.Cells(Rcas, ColT).Value = Turno & Rep
                Ws1.Cells(Rcas, ColT).Interior.ColorIndex = Colore
            End If
        End If
SaltaRT:
    Next RT
Next RRL
Next ColT
End Sub

Da inserire nel modulo in sostituzione della precedente macro (stesso nome)

ciao

[Sasyjoe]

Flash ti ringrazio tanto.
Appena posso la provo.

[Flash30005]

Spero di poter almeno sapere se ha soddisfatto l'esigenza
secondo me si!

ciao

[Sasyjoe]

Grazie per il lavoro.
Si avvicina molto a quel che volevo.

Il problema nasce quando bisogna accodare 2 turni.
Esce due volte la segnalazione, ma accoda solo 1 turno.

Puoi assegnare i primi turni da accodare ai secondi responsabili e poi se neanche i secondi responsabili non bastano lo accodi sotto?


Grazie infinite Flash.

[Flash30005]

Non so come creare la situazione

ciao

[Sasyjoe]

se il problema è:
"Puoi assegnare i primi turni da accodare ai secondi responsabili e poi se neanche i secondi responsabili non bastano lo accodi sotto?"

Possiamo anche saltarlo, mi adatto io.

Però sarebbe molto utile invece:
"Il problema nasce quando bisogna accodare 2 turni.
Esce due volte la segnalazione, ma accoda solo 1 turno."

Grazie FLASH!

[Sasyjoe]

Flash purtroppo va in debug se un collaboratore è non di sopnibile sia di mattina che pomeriggio.
La cosa strana è che non succede tutti i giorni!!
Solo alcuni giorni va in debug

Ciao

[Sasyjoe]

Flash purtroppo va in debug se un collaboratore è non disopnibile sia di mattina che di pomeriggio.
La cosa strana è che non succede tutti i giorni!!
Solo alcuni giorni va in debug.

GRAZIEEE!