Condividi:        

Excel - turni di lavoro

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

Excel - turni di lavoro

Postdi raimea » 03/08/12 21:07

questa volte e' un po piu "difficile".. :-?

vorrei compilare il foglio --> ricerche
nella cella D6 scrivo un numero, e vado a cercarlo in fgl genn.13 da F300 in giu'
e quindi ne ricavo il nome da scrivere in E6.
poi nel fgl genn13 vado a cercare tale numero nel range F5:DB31
in modo da riportare la data di quando e' di turno in Col F6 in giu'

le date da controllare e riportare, sono scritte nel fgl gen 13 nelle colonne E,U,AK,BA,BQ, CG.

la stessa cosa vorrei realizzarla per il num che scriverei in fgl ricerche J6
in modo di poter confrontare 2 persone contemporaneamente.

spero di essere stato chiaro
provo ad allegare il file

https://rapidshare.com/files/2514960120/sito.rar
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Sponsor
 

Re: Excel - turni di lavoro

Postdi Flash30005 » 03/08/12 23:00

raimea ha scritto:provo ad allegare il file

Ma come si scarica il file?

Il post è inerente ai turni di lavoro?

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Excel - turni di lavoro

Postdi raimea » 04/08/12 05:07

si' , il post e' inerente ai turni.
io ho provato a scaricarlo e x me' e' ok ,
come negli altri casi.
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi raimea » 04/08/12 16:58

azz mi sa che rapidshare ha problemi
ho scoperto che con crome tutto ok ,
con explorer non apre la pagina :roll:

ora ho provato anche a ri.caricarle il file

https://rapidshare.com/files/3076632420/sito.rar
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi Flash30005 » 05/08/12 14:01

Quello che noto è che ora è un HTTPS connessione protetta con certificati, inoltre usano porte diverse da HTTP
(HTTP si appoggia generalmente sulla porta 80 mentre HTTPS sulla porta 443)
prova ad usare altri host
http://uploading.com/ o http://sharesend.com

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel - turni di lavoro

Postdi raimea » 05/08/12 14:20

ok, ho provato a metterlo qui:
http://uploading.com/files/get/fb924b2a/sito.rar

sperom... :-?
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi Flash30005 » 05/08/12 15:31

Prova questa macro
Codice: Seleziona tutto
Sub Ricerca()
Sheets("ricerche").Select
Range("F6:F200").ClearContents
Range("L6:L200").ClearContents
NumUD = [D6]
NumUJ = [J6]
For RRF = 301 To 400
If Sheets("genn.13").Range("F" & RRF).Value = NumUD Then [E6] = Sheets("genn.13").Range("G" & RRF).Value
If Sheets("genn.13").Range("F" & RRF).Value = NumUJ Then [K6] = Sheets("genn.13").Range("G" & RRF).Value
Next RRF
For RRF = 5 To 31
For CC1 = 6 To 106
Select Case CC1
Case 6 To 20
CCD = 5
Case 22 To 36
CCD = 21
Case 38 To 52
CCD = 37
Case 34 To 68
CCD = 53
Case 70 To 84
CCD = 69
Case 86 To 106
CCD = 85
End Select
If Sheets("genn.13").Cells(RRF, CC1).Value = NumUD Then
'If Range("F" & URL).Value = "" Then MsgBox RRF
URF = Range("F" & Rows.Count).End(xlUp).Row + 1
'If URF = 8 Then MsgBox RRF & " " & CCD & " " & Sheets("genn.13").Cells(RRF, CCD).Value
Range("F" & URF).Value = Sheets("genn.13").Cells(RRF, CCD).Value
End If
If Sheets("genn.13").Cells(RRF, CC1).Value = NumUJ Then
URL = Range("L" & Rows.Count).End(xlUp).Row + 1
Range("L" & URL).Value = Sheets("genn.13").Cells(RRF, CCD).Value
End If

Next CC1
Next RRF
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel - turni di lavoro

Postdi raimea » 05/08/12 15:36

MITICO..... :eeh:
grazie , grazie,grazie... e' tutto ok.

ora mi arrangio a sistemare i "contorni",
ma la vera macro non ci sarei mai riuscito
grazie 1.000.. :D
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi Flash30005 » 05/08/12 18:13

Sul foglio "Ricerche" puoi inserire questo codice
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$6" And Target.Address <> "$J$6" Then Exit Sub
Ricerca
End Sub


Avrai la ricerca per ogni variazione di "D6" o "J6" ;)

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel - turni di lavoro

Postdi raimea » 05/08/12 18:41

ok,
grazie 1000
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Excel - turni di lavoro

Postdi raimea » 27/01/13 08:35

ciao
dovrei compilare l'elenco dei turni....
provo a descrivere come e' impostato:

il num dei dipendenti e' scritto in cella D1 (77).
il num dei dipendenti che deve essere in turno ogni giorno
lun - ven, e' scritto in ED3 (11).

i turni del sabato li ho gia inseriti e sono ok,

unica condizione nel compilare i turni dal Lun-Venr:
- e' che se un dipen. e' di turno di sabato, NON deve essere
di turno durante quella settimana lun-ven.
- un dipend nella stessa settimana deva fare max 1 SOLO gg di turno.
(potrebbe succedere che in una settimana non sia presente il suo numero, ma non puo fare 2 turni stessa settim)

naturalmente prima che un dipend ripeta un turno ,
tutti gli altri devono averlo fatto .

mi basta la combinazione del primo "ciclo", di rotazione
perche' poi faccio copia-incolla fino alla data che mi serve.

provo ad allegarvi il file.

http://dl.dropbox.com/u/96374724/mio.progett.rar

grazie ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi Anthony47 » 28/01/13 00:16

Prova in un nuovo modulo questo codice:
Codice: Seleziona tutto
Dim myPeop() As Boolean, myTot As Long
Sub calcolaT()
Dim myBet As Long
Dim myShift As Long, I As Long, J As Long, WD As Long
'
myTot = Range("D1"): myShift = Range("ED3")
ReDim myPeop(1)
Randomize
StartI = Cells(150, 6).End(xlUp).Row + 1: If StartI < 5 Then StartI = 5
For I = StartI To Cells(Rows.Count, "CH").End(xlUp).Row
DoEvents
    For WD = 1 To 5
        For J = 0 To myShift - 1
            myBet = GetTurn(I)
            Cells(I, 6 + (WD - 1) * 16 + J).Value = myBet
            myPeop(myBet) = True
            DoEvents
        Next J
    Next WD
'ReDim myPeop(1)
Call NewDay(I)
Next I
MsgBox ("Eseguito da riga " & StartI & " a riga " & Cells(Rows.Count, "CH").End(xlUp).Row)
End Sub

Function GetTurn(ByVal Day As Long) As Long
reBet:
If UBound(myPeop, 1) < myTot Then
'initialize
DoEvents
    ReDim myPeop(1 To myTot)
    For J = 6 To 106
        If Cells(Day, J) <> "" And Cells(Day, J) < 100 Then myPeop(Cells(Day, J)) = True
    Next J
End If
myBet = Int(myTot * Rnd() + 1) ': myBet = 1
For I = 1 To myTot
DoEvents
    If myPeop(myBet) = True Then
        myBet = myBet + 1
        If myBet > myTot Then myBet = 1
    Else
        GetTurn = myBet
        Exit Function
    End If
Next I
'qui se non c' e' nessun ulteriore vuoto, ricomincia
Erase myPeop
ReDim myPeop(1)
GoTo reBet
End Function

Function NewDay(ByVal olDay As Long)
For J = 86 To 106
'If Cells(olDay, J) <> "" Then myPeop(Cells(olDay, J)) = False
If Cells(olDay + 1, J) <> "" Then myPeop(Cells(olDay + 1, J)) = True
Next J
End Function

Poi lanci la CalcolaT, compilera' tutte le settimane per cui il Sab e' gia' pianificato, partendo dalla prima riga del range F5:F150 che ha la colonna F vuota; se quindi vuoi fare diverse simulazioni dovrai come minimo cancellare il contenuto delle colonne F:CF, corrispondenti alle pianificazioni Lu-Ven, oppure aggiungere ulteriori righe di Sabati pianificati.

Ho fatto un sofisticato controllo a occhio e croce, a te rilevare gli errori piu' subdoli e meno apparenti.

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

Re: Excel - turni di lavoro

Postdi raimea » 28/01/13 07:07

:eeh:
tutto ok
ora riesco da solo a procedere per altre piccole cose,
grazie mille
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi raimea » 28/01/13 19:06

ciao
piccolo accorgimento, non so se sara' possibile... :-?
pur mantenendo le descrizioni precedenti che vengono rispettate dalla macro,
mi hanno fatto notare che i numeri/dipendenti non sono distribuiti in maniera equilibrata fra i vari giorni lun/ven.

cioe' ES: succede che un dipend faccia 5 mercol e 1 solo lunedi.

sarebbe possibile che nel distribuire il numero , lo si piazzi nel giorno con meno presenze
nel modo che ogni dipendente alla fine faccia lo stesso num di lun , marted, mercol... :?:

con una piccola differenza fra un dipend e l' altro rispetto allo stesso giorno della settimana.

vi ringrazio
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi Anthony47 » 28/01/13 20:55

La macro oggi fa un sorteggio casuale di chi mettere in turno, sequenzialmente, col solo vincolo di 1 impegno a settimana e di impegnare tutti prima di reimpegnare una stessa risorsa.
Vedro' cosa si puo' fare senza rifare daccapo...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel - turni di lavoro

Postdi raimea » 31/01/13 07:50

:-?
Vedro' cosa si puo' fare senza rifare daccapo...

senza fretta, ma ci spero.. :)
dopo aver fatto girare la macro , sto' tentando di ordinare i numeri manualmente ,
spostandoli da un gg all'altro in modo di tentare di equilibrare per ogni dipend,
il numero di turni per ogni gg della settimana
ma e' un "casino" non indifferente.... :eeh:

ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi Anthony47 » 01/02/13 19:38

Dopo aver invano cercato una aggiunta che pareggiasse i conti (purtroppo i risultati sono stati scadenti) ho cambiato totalmente approccio. Questa macro dovrebbe garantire un buon bilanciamento tra i giorni:
Codice: Seleziona tutto
Dim myPeop() As Single, myTot As Single
Dim myBet As Long, StartI As Long, LastI As Long, myShift As Long
Sub calcolaTTT()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=95853&p=564799#p564799
'vedi anche [byRAIMEA_mioprogett_B30127-Recover-Ver222.xls] per versione debug
Dim I As Long, J As Long, WD As Long
Dim Shifts As Long, AvgD As Single
'
Sheets("turni").Select
'Range("toMyData").ClearContents                    'Test only
'Sheets("Foglio1").Range("AA:AE").ClearContents     'debug only

myTot = Range("D1"): myShift = Range("ED3")
ReDim myPeop(1 To myTot, 1 To 5)
StartI = Cells(150, 6).End(xlUp).Row + 1: If StartI < 5 Then StartI = 5
LastI = Cells(Rows.Count, "CH").End(xlUp).Row

Shifts = (LastI - StartI + 1) * myShift * 5

Randomize
For I = StartI To LastI
DoEvents
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    For WD = 1 To 5
        For J = 0 To myShift - 1
            myBet = GetTurn(I, WD)
            Sheets("turni").Select
            Cells(I, 6 + (WD - 1) * 16 + J).Value = myBet
            DoEvents
        Next J
    Next WD
Call NewDay(I)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox ("Eseguito da riga " & StartI & " a riga " & Cells(Rows.Count, "CH").End(xlUp).Row)
End Sub

Function GetTurn(ByVal Riga As Long, ByVal GGG As Long) As Long
'estrae il Numero Operatore per quel turno
'Riga=riga a cui si riferisce il calcolo    GGG=Giorno settimana (1=Lun, 2=Mar,...)
'
Dim myGuess As Long
'
reBet:
DoEvents
If Riga > (StartI + 2) Then
'in fase iniziale, sorteggio random
    myGuess = myBGUess(Riga, GGG)
Else
'poi estrazione "best fit"
myGuess = Int(Rnd() * myTot + 1) '(myBet + 1) Mod myTot + 1
End If
'conferma "best fit" (non estratto sulla riga)
If Application.WorksheetFunction.CountIf(Sheets("turni").Cells(Riga, 6).Resize(1, 106 - 6), myGuess) = 0 Then
    GetTurn = myGuess
    myBet = myGuess
    Exit Function
End If
GoTo reBet
End Function


Function myBGUess(ByVal myDay As Long, ByVal GGG As Long) As Long
'Estrae il "best fit" per quella Riga /Turno
'
Dim MinGuess As Single
MinGuess = 9999
myRand = Int(Rnd() * myTot * 2 + 1)
For MyJ = myRand To myRand + myTot
    jj = 1 + (MyJ Mod myTot)
    If myPeop(jj, GGG) < MinGuess Then
        If GGG > 3 Or Application.WorksheetFunction.CountIf(Sheets("turni").Cells(myDay - 1, 86).Resize(1, 21), jj) = 0 Then
            MinGuess = myPeop(jj, GGG)
            myBGUess = jj
        End If
    End If
Next MyJ
    myPeop(myBGUess, 1) = myPeop(myBGUess, 1) + 10
    myPeop(myBGUess, 2) = myPeop(myBGUess, 2) + 10
    myPeop(myBGUess, 3) = myPeop(myBGUess, 3) + 10
    myPeop(myBGUess, 4) = myPeop(myBGUess, 4) + 10
    myPeop(myBGUess, 5) = myPeop(myBGUess, 5) + 10
'Sheets("Foglio1").Range("T2:X80") = myPeop()       'debug only
End Function

Function NewDay(ByVal olDay As Long)   'dummy parameter
'Compila frequenza per operatore /Turno, a inizio riga
'
Dim CurrJJ As Integer, CurrJJ0 As Integer
For jj = 1 To myTot
    CurrJJ0 = Application.WorksheetFunction.CountIf(Range("F" & StartI).Resize(LastI - StartI + 1, 85 - 6 + 1), jj)
    For kk = 1 To 5
        CurrJJ = Application.WorksheetFunction.CountIf(Range("F" & StartI).Offset(0, (kk - 1) * 16).Resize(LastI - StartI + 1, 15), jj)
        myPeop(jj, kk) = CurrJJ + CurrJJ0 / 1000
    Next kk
Next jj
End Function

Sostituisce in toto la versione precedente.

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

Re: Excel - turni di lavoro

Postdi raimea » 01/02/13 20:13

ottimo... :eeh: :eeh:
non ho parole..,
e' tutto ok,

grazie mille.
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi raimea » 01/02/13 21:11

piccolo bug
se in EA3 scrivo un num inferiore ad 80
automatic in ED3 ottengo il numero 12 o inferiore.
e qui tutto ok.

se in EA3 scrivo un num maggiore di 80 es. 90
tale che in ED3 ottengo 13, (magg di 12), la macro si blocca.

la devo sbloccare manualmente ,
ed ho notato che i calcoli rimangono in --> manuale.

non saprei dove controllare x risolvere cio..

allego il file.
http://dl.dropbox.com/u/96374724/turni-macro_2.4.rar

ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Excel - turni di lavoro

Postdi raimea » 01/02/13 21:44

:undecided: errore mio.... :undecided:
ho visto che la macro "lavora " utilizzando il riferimento in cella D1
che non avevo correttamente settato..

TUTTO OK

chiedo scusa
grazie ancora..
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "Excel - turni di lavoro":


Chi c’è in linea

Visitano il forum: Nessuno e 50 ospiti