Alcune volte mi sono trovato nella necessità di estrarre un numero a caso prelevandolo da una lista di numeri disordinati (immaginate il sacchetto con i numeri della tombola). L’estrazione casuale non deve più considerare il numero appena uscito e quindi i numeri estratti non devono essere reinseriti nella lista. Una nota: ci sarebbe da discutere sulla funzione che genera i numeri casuali, ma ci vorrebbe un altro articolo 🙂 accontentiamoci di quello che passa il convento Microsoft e facciamo finta che Rnd generi davvero un numero causale nell’intervallo tra zero e uno.
1) The first generation
La prima funzione che avevo creato è stata questa:
Function genera_lista_univoca_from_to(min As Long, max As Long) As Variant
Dim lista() As Long
Dim i As Integer
Dim r1 As Long
Dim r2 As Long
Dim tmp As Long
'genera una lista di numeri casuali non ripetuti nel range specificato
'esempio:
'u = genera_lista_univoca_from_to(1, 10)
'For Each k In u
' Debug.Print k;
'Next
Randomize Timer
ReDim lista(1 To max) As Long
If min > max Then min = 1
'genera la lista di numeri consecutivi tra min e max
For i = min To max
lista(i - min + 1) = i
Next
'quindi la disordina
For i = 1 To 1000
r1 = Int(Rnd * (max - min) + min)
r2 = Int(Rnd * (max - min) + min)
'swap
tmp = lista(r1)
lista(r1) = lista(r2)
lista(r2) = tmp
Next
genera_lista_univoca_from_to = lista()
End FunctionLa Function chiede due numeri in ingresso, un minimo e un massimo, quindi genera una lista di numeri casuali non ripetuti nell’intervallo tra i due numeri specificati. Non viene eseguito un controllo serio se, per esempio, il primo numero è maggiore del secondo; il codice si limita a reimpostare il minimo al valore 1. Con poco sforzo si può implementare la variante che scambia tra loro i due numeri. Lasciamo questo esercizio al lettore volenteroso 🙂
2) The next generation
La seconda funzione, un po’ più intelligente, accetta in ingresso una lista (di numeri o di stringhe di testo) e un numero che indica quante estrazioni casuali non ripetute dalla lista vogliamo effettuare.
Function estrai(lista As Variant, num_estrazioni As Integer) As Variant
Dim i As Integer
Dim k() As Variant
Dim r1 As Integer
Dim r2 As Integer
Dim tmp As Variant
'da una lista (numeri o testo) ordinata in modo casuale estrae il numero di elementi specificato
'restituisce Falso se si chiedono più estrazioni degli elementi contenuti
'for each k in estrai(array(1,2,3,4,5),3)
' debug.print k;
'next
'for each k in estrai(array("a", "b", "c", "d", "e"),3)
' debug.print k;
'next
If num_estrazioni > UBound(lista) + 1 Or num_estrazioni <= 0 Then
estrai = False
Exit Function
End If
Randomize Timer
'shuffle
For i = 1 To 1000
r1 = Int(Rnd * UBound(lista)) + LBound(lista)
r2 = Int(Rnd * UBound(lista)) + LBound(lista)
'swap
tmp = lista(r1)
lista(r1) = lista(r2)
lista(r2) = tmp
Next
ReDim k(UBound(lista))
For i = 0 To num_estrazioni - 1
k(i) = lista(i)
Next
ReDim Preserve k(i - 1)
estrai = k()
End FunctionIn questa versione siamo liberi di inserire liste di numeri o testo, per avere maggiore versatilità nell’input (che potrebbe provenire anche da un Range di Excel), ma non è ancora una soluzione abbastanza evoluta.
3) Smart functions for smart people!
Il punto di arrivo della mia ricerca della perfezione è stato produrre una funzione che accettasse in input diversi tipi di dato e si comportasse in modo furbo per restituire quello che doveva, in modo da intuire l’intenzione dell’utente: se chiediamo la generazione da una lista di numeri, otterremo una lista di numeri, se passiamo una stringa, otterremo le lettere disordinate della stringa (cioè pescate a caso), se passiamo più stringhe o un range multiplo, otterremo una combinazione casuale dei singoli contenuti. Il risultato dell’elaborazione è sempre una stringa composta dagli elementi restituiti dalla funzione, separati per default da uno spazio.
E poichè l’appetito vien mangiando, in questa terza revisione ho implementato anche la possibilità di specificare un delimitatore tra gli elementi restituiti. Il delimitatore può essere anche una parola, non solo un carattere.
Qualche esempio da provare in finestra Immediata:
>> listRandom(array(1,2,3,4,5),3) –> “2 4 1”
>> listRandom(5, 3) –> “2 4 1”
>> listRandom(“hello”, 5) –> “e o l l h”
>> listRandom(“ombrello”, 3, “:”) –> “l:o:m”
>> listRandom(“ombrello”, 3, “orzo”) –> “lorzomorzob”
>> listRandom(range(“A1:A3”), 3, “:”) –> range(“A2”), range(“A1”), range(“A3”)
E la funzione finalmente è questa:
Function listRandom(vettore As Variant, num_estrazioni As Long, Optional delimiter As String = " ") As String
Dim i As Integer
Dim r1 As Long, r2 As Long, tmp As Variant
Dim s As String, lim_inf As Integer, lim_sup As Integer
Dim v As Variant
Randomize Timer
If delimiter = "" Then delimiter = Chr(0)
Select Case TypeName(vettore)
Case "Range"
'se range.column > 1, ridimensiona alla prima colonna
If vettore.Columns.Count > 1 Then Set vettore = vettore.Resize(, 1)
'se una cella, estrae il testo come fosse una stringa
If vettore.Cells.Count = 1 Then
v = Split(StrConv(vettore, vbUnicode), Chr(0))
Else
'altrimenti considera il testo di ogni cella a sè stante
vettore = WorksheetFunction.Transpose(vettore)
v = vettore
End If
Case "String", "String()"
'il testo semplice viene splittato carattere per carattere
v = Split(StrConv(vettore, vbUnicode), Chr(0))
Case "Integer", "Long", "Single", "Double"
'un valore numerico indica un range da cui pescare un numero a caso
If TypeName(vettore) = "Single" Or TypeName(vettore) = "Double" Then
vettore = WorksheetFunction.Round(vettore, 0)
End If
For r1 = 0 To vettore - 1
s = s & r1 & delimiter
Next
v = Split(s, delimiter)
End Select
lim_sup = UBound(v)
lim_inf = LBound(v)
If num_estrazioni > UBound(v) Then num_estrazioni = UBound(v)
'shuffle
For i = 1 To 1000
r1 = Int(Rnd * lim_sup) + lim_inf
r2 = Int(Rnd * lim_sup) + lim_inf
'swap
tmp = v(r1)
v(r1) = v(r2)
v(r2) = tmp
Next
s = ""
For i = lim_inf To (num_estrazioni - 1 + lim_inf)
If i > lim_sup - (-lim_inf) Then Exit For
s = s & v(i) & delimiter
Next
If s <> "" Then s = Left(s, Len(s) - Len(delimiter))
listRandom = s
End FunctionLa Function accetta tre parametri: il vettore di valori (può essere un range di Excel, un numero, una lista di stringhe, una stringa sola) e il numero di estrazioni da effettuare, cioè il numero di elementi da restituire. Il terzo parametro è facoltativo e indica il separatore tra gli elementi nel risultato di ritorno della Function.
Un’applicazione divertente è questa banalissima funzioncina per generare un anagramma. Non produce tutti gli anagrammi possibili di una parola, ma rimescola le lettere a caso e restituisce il risultato:
Function anagrams(s As String) As String
Do
anagrams = listRandom(s, Len(s))
Loop Until anagrams <> s
End FunctionProvate in finestra immediata!
>> ? anagrams(“ombrello”)
>> o b l l r o m e
› Come estrarre numeri e testo in modo casuale
-
-
-
Login Registrati