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 Function

La 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 Function

In 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 Function

La 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 Function

Provate in finestra immediata!
>> ? anagrams(“ombrello”)
>> o b l l r o m e

Come estrarre numeri e testo in modo casuale
Tag:             

Come estrarre numeri e testo in modo casuale

Login Registrati
Stai vedendo 4 articoli - dal 1 a 4 (di 4 totali)
  • Autore
    Articoli
  • #11887 Risposta

    vecchio frac
    Senior Moderator
      96 pts

      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... [Leggi tutto al seguente link: https://www.excelvba.it/forumexcel/come-estrarre-numeri-e-testo-in-modo-casuale/]

      #11949 Risposta
      Luca73
      Luca73
      Partecipante
        8 pts

        Ciao VF

        C'è qualcosa che non capisco penso sia un errore ma potrei sbagliare. Mi sono fermato al primo caso.

        Quando generi il vettore iniziale 

        For i = min To max
                lista(i - min + 1) = i
        Next`

         Stai generando un vettore che contiene i numeri e con un suo indice che andra da 1 a max -min +1 (ovvero il numero di elementi)

        (i - min + 1) per i = min value 1
        (i - min + 1) per i = max value max-min+1

        Quando poi fai lo swop generi r1 e r2 che variano tra max e min 

        r1 = Int(Rnd * (max - min) + min)
        r2 = Int(Rnd * (max - min) + min)

        Successivamente 

        tmp = lista(r1)
        lista(r1) = lista(r2)
        lista(r2) = tmp

        pertanto il range di R1 e R2 in tutti i casi in cui min è diverso da 1 sara diverso dalk range dell'indice del vettore.

        Ho ragione? Penso che tu sia partito tra 0 e Max tant'è che è rimasto anche un 

        ReDim lista(1 To max) As Long

        La soluzione è usare un sistema tipo nell'esempio due in cui r1 e r2 vengono calcolati sulla base dell Ubound di Lista

         

        #11950 Risposta
        Luca73
        Luca73
        Partecipante
          8 pts

          Ciao VF 

          se dovessi pensare ad una estrazione "tipo tombola" io l'avrei generata esattamente estraendo un valore alla volta e poi non considerandolo più

          pertanto avrei pensato a qualcosa del genere:

          Sub LTgenera_lista_univoca_from_to()
          Dim lista() As Long
          Dim i As Integer
          Dim r1 As Long
          Dim r2 As Long
          Dim tmp As Long
          Dim min As Long
          Dim max As Long
          
          min = 100
          max = 110
          
              Randomize Timer
             
              If min > max Then min = 1
              ReDim lista(1 To max - min + 1)
              'genera la lista di numeri consecutivi tra min e max
              For i = min To max
                  lista(i - min + 1) = i
              Next
              For i = 1 To UBound(lista, 1)
                  r1 = Int(Rnd * ((max - min + 1) - i + 1) + i)
                  r2 = i
                  'swap
                  tmp = lista(r1)
                  lista(r1) = lista(r2)
                  lista(r2) = tmp
              Next
          End Sub

          L'ho trasformata in sub per facilità di debug.

          Praticamente invece di far ciclare 1000 volte ho pensato di far ciclare tante volte quante è il numero di elementi.

          L'elemento selezionato all'i-esimo ciclo vine spostato alla i-esima posizione e al ciclo successivo vado a considerare solo gli elementi superiori alla i+1-esima posizione.

          Personalmente anziché fare uno swop avrei generato un vettore di appoggio ma la tua soluzione è più semplice ed elegante.

          Ciao

          Luca

          #11951 Risposta

          vecchio frac
          Senior Moderator
            96 pts

            Ma certamente.

            Luca73 ha scritto:

            L'elemento selezionato all'i-esimo ciclo vine spostato alla i-esima posizione

            Questa poi è una tecnica consolidata, che conosco, e va benissimo 🙂  Che dirti, facevo l'esempio della tombola ma tant'è, il codice anzitutto è frutto di diverse passate a partire da qualche anno fa, e poi non è ottimizzato proprio per la tombola, quello era un esempio che mi è venuto in mente. Infine, è abbastanza chiaro che ci sono tante soluzioni a qualsiasi problema. 

            Sull'osservazione del primo post, è più che pertinente: è plausibile che salti fuori un errore quando riadatti dei codici vecchi, non sai mai che filosofia ci stava dietro, anche se sono tuoi. A dirla tutta quando ho steso l'articolo puntavo di più sulla funzione principale, che è listRandom().

            Guardandola meglio è evidente l'ingenuità sopratutto della generazione di mille estrazioni casuali per il riordino   

          Login Registrati
          Stai vedendo 4 articoli - dal 1 a 4 (di 4 totali)
          Rispondi a: Come estrarre numeri e testo in modo casuale
          Gli allegati sono permessi solo ad utenti REGISTRATI
          Le tue informazioni:



          vecchio frac - 1415 risposte

          albatros54
          albatros54 - 531 risposte

          patel
          patel - 353 risposte

          Marius44
          Marius44 - 322 risposte

          Luca73
          Luca73 - 290 risposte