Realizzare la Tombola in Excel.     (29/03/03)

Ogni tanto ci possiamo anche divertire, e coloro che dicono che il computer "isola" potranno rivedere le proprie idee. Cosa c'è di meglio che riunire la famiglia o degli amici per giocare alla vecchia, cara, Tombola ? Con il computer verrà gestito il "Tabellone" e curata l'estrazione dei numeri, così nessuno potrà dire che "i numeri vengono scelti", sarà infatti il vba di Excel a provvedere ad un'estrazione completamente casuale.

Presento quindi una routine basata sulla randomizzazione ( ROUND() ) i cui concetti li ho presentati nel paragrafo precedente in questa stessa sezione ("Estrarre dati casuali"). In questo esercizio era necessario creare due gruppi di istruzioni : una routine che si occupasse di generare un numero casuale compreso tra 1 e 90, ed un'altra che si occupasse di controllare, ed interrompere, uscendo, quando tutti i 90 numeri fossero stati estratti. Ho pensato di semplificare le cose, preparando il tabellone con già inseriti tutti i 90 numeri, e di evidenziare il numero estratto in questo modo:

  • Colorare il numero in rosso

  • Rendere il Font in grassetto

  • Colorare la cella contenente il numero, evidenziandola in giallo.

  • Avvisare con un messaggio il numero estratto.

  • Avvisare con un messaggio quando il tabellone è completo.

un immagine del Tabellone durante un'estrazione:

L'idea della realizzazione quindi si basa non sull'inserimento dei numeri estratti in una tabella, che ci avrebbe costretto a memorizzare la posizione di ogni numero nella sua cella di competenza, e successivo controllo della sua esistenza (del numero ) per casualizzare un nuovo numero nel caso fosse già "uscito" e successiva identificazione della relativa cella di appartenenza, ma, secondo me più semplice, al controllo se un numero sia già evidenziato in rosso; in caso sia nero, leggo il valore (il numero) presente nella cella,  avviso col messaggio del numero così estratto, e quindi lo coloro di rosso, grassetto, fondo giallo alla cella; mentre per il ciclo di controllo dei numeri estratti, faccio controllare se le celle sono evidenziate in giallo e faccio memorizzare il numero di queste celle se presenti. Se il numero delle celle gialle è uguale a 90 (tutti estratti), esco dalla routine e avviso. Per meglio identificare l'area dove risiede la tabella, uso il classico riferimento ai Range di celle che interessano.(A1:J9). Le istruzioni si commentano da sole, sono quelle già ampliamente usate in tanti esempi su questo sito. L'unica cosa che segnalo e che evidenzio, sono i posizionamenti dei cicli di istruzioni e dei rimandi. Questa la macro:

Sub tombola()
Set zona = Range("A1:J9")
x = zona.Rows.Count
z = zona.Columns.Count


Dim CL As Object
Dim H As Integer
H = 0

'indice riga 10
10:

'qui si controlla, memorizzando con H, quante celle sono di colore giallo; se H sarà uguale 'a 90 si avvisa con un messaggio che il tabellone è completo e si esce dalla routine, se 'invece H è inferiore a 90, si salta all'indice riga 20 per ripetere il ciclo di randomizzazione.
For Each CL In Range("A1:J9")
If CL.Interior.ColorIndex = 6 Then
H = H + 1
End If
If H = 90 Then
MsgBox "Tabellone Completo"
Exit Sub
Else
GoTo 20
End If
Next

'indice riga 20
20:

Randomize
quale = Int((x * Rnd) + 1)
dove = Int((z * Rnd) + 1)
Y = Cells(quale, dove).Value
miacella = Cells(quale, dove).Address
'sotto: si controlla il colore del font di "miacella"; se diverso da 3 (rosso) vuol dire che non ' è ancora uscito
If Range(miacella).Font.ColorIndex <> 3 Then

'si avvisa col numero (Y) estratto
MsgBox "Numero estratto il : " & Y & ""

' lo si colora di rosso, si rende grassetto, e si fa la cella gialla
With Range(miacella)
.Font.ColorIndex = 3
.Font.Bold = True
.Interior.ColorIndex = 6
End With
 

'se invece il colore font è già rosso, si ritorna al ciclo di randomizzazione per generare un 'nuovo numero, recandosi all'indice riga 10
Else
GoTo 10


Exit Sub
End If

End Sub


Sarà poi opportuno predisporre un'altra macro per ristabilire il colore dei numeri in nero, togliere il fondo giallo alle celle, e togliere il grassetto ai font. Predisporremo un'altro pulsante con associata questa routine:

Sub pulisci()
With Range("A1:J9")
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
.Font.Bold = False
End With
End Sub

 

File scaricabile e consultabile  :  La Tombola.zip   10 Kb


prelevato sul sito http://ennius.interfree.it