Estrarre dati casuali (testo) da elenco, con limite di cifra. - dal 04/09/04 pagina vista: volte

Da un'altra domanda nasce questo esercizio per estrarre dati casuali in formato testo (nomi, codici alfanumerici, ecc.), con la fine routine estrazione basata su un valore numerico limite, predefinito. L'esercizio si può prestare ad una molteplicità di situazioni, compreso, per la gestione magazzino di un'azienda, di un'estrazione di articoli da mettere in offerta speciale, casualizzando gli articoli sulla chiave codice articolo e con un massimo di cifra in offerta, oppure, perchè no, nell'estrazione casuale di nomi della cabala, con i loro numeri, per giocate al lotto. Comunque sia. esaminiamo il problema postomi:

Da una tabella formata almeno da una colonna di valori testo e da una colonna di valori numerici correlati al testo, vogliamo estrarre il testo e i numeri collegati, randomizzando l'estrazione sul testo. Vogliamo inoltre che l'estrazione si interrompa quando il totale dei valori numerici estratti insieme al nome, abbia raggiunto o superato un valore determinato. Vogliamo anche creare una nuova tabella con i valori estratti. Vediamo come procedere:

Premessa: per realizzare una randomizzazione dovremo usare un numero, non è possibile farlo col testo; il numero però ci viene fornito dal numero di righe dove è presente il testo, e quindi per prima cosa dovremo identificare la colonna dove è presente il testo da casualizzare, e poi contarne le righe. Per identificare la colonna possiamo ricorrere a sistemi diversi:

  • UsedRange - Se l'elenco è uniforme sul foglio di lavoro, possiamo ricorrervi per definire tutta la tabella, purchè l'ultima riga dell'area comprenda anche l'ultima cella in basso col nome da estrarre, altrimenti otterremo che il numero di righe sia falsato, e poi usare l'indice colonna dove si trova il testo.

  • Riferimento preciso alla colonna che contiene i nomi da estrarre, es. Range("A1:A200"). Questa soluzione è più sicura, ma offre lo svantaggio che variazioni (aggiunte) di dati in tabella, ci costringe a modificare il codice vba per quanto riguarda il riferimento all'intervallo.

  • End - Metodo ottimale per reperire esattamente l'ultima cella occupata; usato con la costante xlDown (verso il basso), ma richiede che tutte le celle della colonna da esaminare contengano valori, altrimenti con una cella vuota nella colonna tra altri valori, si interrompe il reperimento di tutta la colonna, esempio: Range([A1], [A1].End(xlDown)).

Una volta impostata la zona, ne conteremo le righe, il numero ottenuto ci servirà come numero da casualizzare (randomizzare, è lo stesso). La randomizzazione ci fornirà quindi un numero di riga che servirà:

  • a reperire il testo contenuto nella cella della riga estratta.

  • a reperire il valore numerico nella cella a lato, stessa riga

  • useremo quindi un totalizzatore che iniziando a zero, sommi tutti i valori numerici mano a mano associati al testo estratto.

  • ogni valore testo e relativo valore numerico associato estratto, lo copieremo in un'altra zona, formando una tabella con gli estratti

Per poter ripetere l'estrazione, ci affideremo ad un ciclo For...Next, che iniziando da 1 e fino al valore rappresentato dal numero di righe, provveda a garantire la continuazione delle estrazioni. E' in questo ciclo che istruiremo la condizione che SE raggiunto o superato il valore da noi scelto, si uscirà dal ciclo interrompendo l'estrazione. Va detto subito, che l'uscita dal ciclo, per quanto riguarda il rispetto della condizione, dipende solamente dagli importi che verranno sommati: sarà infatti difficile che si verifichi la condizione precisa scelta. Vediamo subito un immagine che spiega meglio:

nell'esempio che propongo, la cifra oltre la quale si interromperà il ciclo, è 20, ma come vediamo, i primi due numeri estratti sono 12 e 6, che fanno 18, quindi il ciclo continua, il terzo numero è 8 che porta il totale a 26 e quindi si esce. Solo se fosse uscito un 2 come terzo numero, avremmo avuto 20. La routine ha lavorato perfettamente. siamo usciti se il totale fosse stato 20 o superiore. Vediamo le istruzioni: (i commenti in verde potranno essere tolti, servono solo come spiegazione)

Sub AcasoTuo()

'come si nota nella foto, il range D1:E1 fino a completamento elenco, è la zona dove 'faccio copiare i dati estratti, per cui ad inizio routine identifico l'area con End, e la 'pulisco (ClearContents) per consentire il refresh dei nuovi dati. Chi volesse invece 'continuare ad accodare dati, dovrà eliminare le tre righe sottostanti:
If [D1] <> "" Then
Range([D1], [E1].End(xlDown)).ClearContents
End If

'con "zona" imposto  con UsedRange, tutta l'area contenente dati
Set zona = ActiveSheet.UsedRange

'con "x" ottengo da quante righe e formato l'elenco "zona"
x = zona.Rows.Count

'imposto un totalizzatore a zero
tot = 0

'inizio il ciclo For Next che ripete le istruzioni comprese nel ciclo, da 0 fino al valore di x
For N = 0 To x

'Per evitare la ripetitività nella sequenza dei valori restituiti dovremo adoperare la funzione 'Randomize che utilizza numero per inizializzare il generatore di numeri casuali della 'funzione Rnd assegnandogli un nuovo valore. Se numero viene omesso, il valore 'restituito dal timer di sistema verrà utilizzato come nuova base.
'Se Randomize non viene utilizzata, quando la funzione Rnd (senza argomenti) viene 'chiamata per la prima volta, utilizza come base lo stesso numero. Per le chiamate 'successive la funzione utilizzerà l'ultimo numero generato.
Randomize

'ora assegniamo alla variabile "quale" un numero di riga generato casualmente e basato 'sul numero rappresentato da "x", e sarà questa variabile che verrà usata per reperire la 'cella da cui "prendere" il valore (insieme all'indice colonna rappresentato dal numero 'nell'istruzione Cells(quale, 1), Cells(quale, 2))
quale = Int(x * Rnd) + 1 'si aggiunge 1 nel caso esca zero

'con le variabili Y prendiamo il testo, e con Z il numero nella cella accanto
Y = Cells(quale, 1).Value 
Z = Cells(quale, 2).Value

'ora incrementiamo il totalizzatore con il valore rappresentato da Z
tot = tot + Z

'fatto questo ci spostiamo nella zona prevista per creare la "tabella estratti" (la D1, con 'iRow impostato alla riga 1 e la colonna impostata a 4 Cells(iRow, 4)), e cerchiamo la 'prima cella libera a partire da D1, con il ciclo While...Wend
Dim iRow As Integer
iRow = 1
While Cells(iRow, 4) <> ""
iRow = iRow + 1
Wend

'trovata la cella libera, si rende uguale al valore di Y (il testo) e di Z (il numero a lato)
Cells(iRow, 4).Value = Y
Cells(iRow, 5).Value = Z

'ora si controlla se il totalizzatore è uguale o maggiore del valore previsto (nel'es.: 20) se 'sarà vera la condizione prevista, si lancia un messaggio col valore raggiunto
If tot >= 20 Then
MsgBox tot

'con Exit For si esce dal ciclo interrompendolo, e quindi dalla routine
Exit For
End If
Next
End Sub

Lavorando sulle condizioni per uscire dal ciclo, sarà possibile crearsi condizioni personalizzate, anche multiple. Poichè nella routine sopra, per effetto del ciclo For..Next la funzione Randomizze, richiamata ad ogni ciclo, può comunque generare numeri già usciti (e quindi stessi nomi e relativi valori), si può decidere di modificare le istruzioni inserendo un controllo che impedisca una doppia uscita degli stessi valori: colorando di giallo le celle estratte ed uscire ripetendo l'estrazione se il numero estratto corrisponde ad una cella gialla. Ad ogni lancio di routine si ripristina il colore di base. Questa la routine, con le spiegazioni solo alle modifiche:

Sub AcasoGiallo()
If [D1] <> "" Then
Range([D1], [E1].End(xlDown)).ClearContents

'si rispristina il colore delle celle della colonna A (i nomi)
Range([A1], [A1].End(xlDown)).Interior.ColorIndex = xlNone
End If
Set zona = ActiveSheet.UsedRange
x = zona.Rows.Count
tot = 0
10:  'indice riga codice
For N = 1 To x
Randomize
quale = Int(x * Rnd)

'estratto il numero, si controlla se la cella è gialla, in questo caso si torna all'indice riga 10 'e si ripete il ciclo di randomizzazione
If Cells(quale, 1).Interior.ColorIndex = 6 Then GoTo 10

'altrimenti si prosegue
Y = Cells(quale, 1).Value

'si colora di giallo la cella estratta, colonna 1
Cells(quale, 1).Interior.ColorIndex = 6
Z = Cells(quale, 2).Value
tot = tot + Z
Dim iRow As Integer
iRow = 1
While Cells(iRow, 4) <> ""
iRow = iRow + 1
Wend
Cells(iRow, 4).Value = Y
Cells(iRow, 5).Value = Z
If tot >= 20 Then
MsgBox tot
Exit For
End If
Next
End Sub

Con queste varianti si avrà la certezza di non duplicare gli estratti. Un'immagine dell'estrazione:

 

Credo che sia tutto ben spiegato, buon lavoro.

prelevato sul sito www.ennius.altervista.org