L'esempio mostra come assegnare dei turni in modo casuale tenendo conto di un calendario da "coprire" e delle disponibilità a copire un certo numero di turni da parte dei alcune persone.
Le regole sono semplici:
- una persona può al massimo coprire il numero di turni per cui ha dato disponibilità;
- la persona non può avere più di un turno nella stessa giornata;
- i turni devono essere assegnati in modo casuale nelle celle indicate come da coprire (in verde);
L'esempio è interessante perchè mostra come sia possibile untilizzare una
struttura dati per organizzare le informazioni della macro in modo chiaro e coerente; un'alternativa all'uso di una
classe.
Il risultato è quello dell'immagine sotto:
La definizione del tipo dati:
Viene creato un
vettore di elementi definiti come tPersona e "riempito" con i valori della tabella delle persone (Nome e disponibilità dei turni); in questo caso uno degli elementi della struttura è a sua volta un vettore che contiene l'informazione di quale giornate sono state già assegnate alla persona.
Dim Persone()
As tPersona
ReDim Persone(1
To TabPersone.
Rows.Count)
TotTurniDisp = 0
For R = 1
To TabPersone.
Rows.Count
Persone(R).Nome = TabPersone(R, 1)
Persone(R).DaFare = TabPersone(R, 2)
'vettore con i giorni già impegnati per la persona
ReDim Persone(R).GgAss(1
To TabGiornate.
Columns.Count)
For gg = 1
To TabGiornate.
Columns.Count - 1
Persone(R).GgAss(gg) = 0
Next gg
'totale turni disponibili
TotTurniDisp = TotTurniDisp + TabPersone(R, 2)
Next R
L'assegnazione dei turni avviene scorrendo i turni disponibili (quelli del calendario che hanno un colore di sfondo alla cella) ed assegnado con un criterio casuale il turno ad una persona.
Deve essere verificato però che per quella persona ci siano ancora turni assegnabili e che non gli sia stato assegnato un'altro turno lo stesso giorno. Da notare che questa combinazione potrebbe non essere possibile (negli ultimi turni assegnati) in questo caso è necessario ricominciare da capo tutta la procedura di assegnazione.
'scorre la tabella dei truni da coprire e assegna le persone in modo casuale
TotTurniAss = 0
iPersPrec = 0
For Each Turno
In TabGiornate
Turno.Select
gg = Turno.Column - TabGiornate.Column + 1
If (Turno.Interior.Color <> xlNone And Turno.Interior.Color <> vbWhite)
Then
'indica la persona successiva in modo casuale
iPers = xp +
Int((TabPersone.
Rows.Count) * Rnd) + 1
iPers = (iPers
Mod TabPersone.
Rows.Count) + 1
'prova se la persona può essere assegnata al turno, altrimenti prova con altra persona
Tentativi = 0
While Not (Persone(iPers).TotAss < Persone(iPers).DaFare And _
Persone(iPers).GgAss(gg) = 0)
iPers = iPersPrec +
Int((TabPersone.
Rows.Count) * Rnd) + 1
iPers = (iPers
Mod TabPersone.
Rows.Count) + 1
Tentativi = Tentativi + 1
If (Tentativi > 20)
Then
' può non essere possibile soddifare tutte le condizioni,
' nel caso ricomincia da capo
GoTo Ricomincia
End If
Wend
iPersPrec = iPers
'assgegna il turno e modifica la disponibilità della persona
Turno.Value = Persone(iPers).Nome
Persone(iPers).TotAss = Persone(iPers).TotAss + 1
Persone(iPers).GgAss(gg) = Persone(iPers).GgAss(gg) + 1
'verifica se sono stati assegnati tutti i turni
TotTurniAss = TotTurniAss + 1
If (TotTurniAss >= TotTurniDisp)
Then
Exit For
End If
End If
Next Turno
Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.
