RANDOM

Hai un problema con Excel?

Nuova discussione

RANDOM
di RINO (utente non iscritto) data: 23/09/2013 23:49:23
Buonasera a tutti,
avrei bisogno di un aiuto.
ho un file con 900 nominativi nella colonna B nella colonna A ho i numeri da 1 a 900, da questo elenco estrapolo in maniera random un certo numero di nominativi il numero lo immetto tramite inputbox, i nominativi estrapolati li copio man mano nel foglio 2 fin qui tutto ok ma non riesco a far in modo che i numeri non si ripetono per cui facciamo un esempio su dieci nomi (o numeri) mi escono 5 8 6 7 5 9 1 2 9 5 il 5 ripetuto tre volte e il 9 due volte.
Qualcuno mi può aiutare in modo che i numeri estrapolati non si ripetono?
Un grazie anticipato a tutti.
Rino
di gaetanopr (utente non iscritto) data: 24/09/2013 00:02:47
con una collection puoi farlo domani ti allego un esempio
random
di rino (utente non iscritto) data: 24/09/2013 00:33:37
grazie a domani

di gaetanopr data: 24/09/2013 08:59:46
Ciao rino, ti allego la macro, io non posso provarla al momento
il funzionamento è semplice, tramite inputbox si sceglie quanti numeri estrarre con la funzione random, così viene riempita una collection di valori univoci, i dati estratti dalla colonna A vengono riportati nella colonna B
A inizio macro si potrebbe aggiungere del codice per eliminare le precedenti etrazioni
qualcosa tipo Range("B1:B900").ClearContents

Saluti

Sub CasualiUnivoci()
Dim Arr As New Collection
Dim n As Long, Casuale As Long
Estrazioni = CInt(InputBox( "Quanti nominativi su 900 max vuoi estrarre ?" ))
On Error GoTo fine
   For n = 1 To Estrazioni
    Randomize
    Casuale = Int((900 * Rnd) + 1)
    Arr.Add Casuale, CStr(Casuale)
fine:
If Err.Number = 457 Then
n = n - 1
End If
 Resume Next
   Next n
For n = 1 To Arr.Count
  Cells(n, 2).Value = Cells(Arr(n), 1).Value
Next
Set Arr = Nothing
End Sub

di rino (utente non iscritto) data: 24/09/2013 09:20:42
Funziona alla grande era proprio quello che volevo, adesso debbo solo adattarla al mio scopo.
Ti ringrazio e alla prossima

di Vecchio Frac data: 24/09/2013 09:58:24
In ogni caso il metodo più veloce in assoluto di estrarre dei numeri è mettere tutti gli elementi in una Collection (monodimensionale quindi), generare un numero Random fra 1 e Collection.Count ed estrarre/rimuovere l'elemento con quell'indice dalla Collection, il tutto finchè Collection.Count > 0.

Propongo comunque una piccola funzioncina che lavora in un modo un po' diverso.
Utilizzo:
- in VBA restituisce una stringa, il codice è facilmente modificabile, estrae tre numeri dall'array speicifcato come argomento:
msgbox casuale_senza_dups(array(1,2,3,4,5), 3)

- come formula in un foglio di lavoro (se metti il codice in un modulo pubblico), estrae cinque numeri non ripetuti prelevandoli dal range A1:A10:
=CASUALE_SENZA_DUPS(A1:A10, 5)

My 2 cents.

Option Explicit

Function casuale_senza_dups(vettore As Variant, num_estrazioni As Long) As String
'verificato OK sia con range che con vettori - 18/3/2013
Dim i As Integer, vect() As Variant
Dim r1 As Long, r2 As Long, tmp As Variant
Dim s As String, lim_inf As Integer, lim_sup As Integer

    Randomize Timer
    
    'nb fallisce se range.column > 1
    If TypeName(vettore) = "Range" Then
        vect = WorksheetFunction.Transpose(vettore)
        lim_sup = UBound(vect)
    Else
        vect = vettore
        lim_sup = UBound(vect) + 1
    End If
    
    lim_inf = LBound(vect)
    
    'shuffle
    For i = 1 To 1000
        r1 = Int(Rnd * lim_sup) + lim_inf
        r2 = Int(Rnd * lim_sup) + lim_inf
        'swap
        tmp = vect(r1)
        vect(r1) = vect(r2)
        vect(r2) = tmp
    Next
    
    For i = lim_inf To (num_estrazioni - 1 + lim_inf)
        If i >= lim_sup - (-lim_inf) Then Exit For
        s = s & vect(i) & "-"
    Next
    If s <> "" Then s = Left(s, Len(s) - 1)
    casuale_senza_dups = s

End Function

di Grograman data: 24/09/2013 10:00:40
Maronnamia quella di VF la devo ancora digerire, stavo per postare la variante di quella di Gaetano

Option Explicit

Sub CasualiUnivoci()
Dim Arr As Collection
Dim n As Long, Casuale As Long
Dim Estrazioni As Integer

  Estrazioni = Application.InputBox("Quanti nominativi su 900 max vuoi estrarre ?", Type:=1)
  
  Set Arr = New Collection
  On Error Resume Next
  Do
    Casuale = (900 * Rnd) + 1
    Arr.Add Casuale
  Loop Until Arr.Count = Estrazioni

  For n = 1 To Arr.Count
    Cells(n, 3).Value = Cells(Arr(n), 1).Value
  Next
  
  Set Arr = Nothing
End Sub

di Grograman data: 24/09/2013 10:02:40
Che, aggiungerei, non funziona... (la mia intendo).
Se randomizza un valore già presente aumenta il contatore erroneamente
di gaetanopr data: 24/09/2013 10:11:15
cit>>>Se randomizza un valore già presente aumenta il contatore erroneamente
Ciao Grognaman, io in caso di errore, quindi di valore ripetuto, ripeto lo stesso contatore tramite un banale if then
If Err.Number = 457 Then n = n - 1 End If
di vbabus (utente non iscritto) data: 24/09/2013 11:05:27
ho fatto un'aggiunta alla procedura
alla fine ho aggiunto questa parte per cancellare le righe con i numeri già utilizzati
come si potrebbe sostituire il comando replace con un delete perché non riesco a farlo funzionare
grazie
Dim v As Range For Each v In [b1:b900] [a1:a900].Replace v, "", xlWhole Next
di HarryBosch data: 24/09/2013 11:44:01
@ Gaetanopr
cit ->"in caso di errore, quindi di valore ripetuto, ripeto lo stesso contatore tramite un banale if then"
perché utilizzi un ciclo if dove ovviamente il contatore non deve essere aggiornato in caso di ripetizione; per questo motivo un ciclo DO è (a mio avviso) più adatto allo scopo

@Grograman
cit -> "Se randomizza un valore già presente aumenta il contatore erroneamente"
si può evitare inserendo una chiave univoca:
Arr.Add Casuale, Cstr(casuale)

In entrambi i casi ricordatevi di inserire ad esempio:
Randomize Timer
in testa al codice come ha fatto VecchioFrac :)
Altrimenti, ogni volta che riaprite il file troverete le stesse (e dico proprio identiche) successioni di numeri random ^_^
di gaetanopr data: 24/09/2013 12:25:35
cit ->"perché utilizzi un ciclo if dove ovviamente il contatore non deve essere aggiornato in caso di ripetizione; per questo motivo un ciclo DO è (a mio avviso) più adatto allo scopo"
Effettivamente un ciclo Do si presta meglio alla situazione evitando di riportare indietro il contatore in caso di valori ripetuti.
sono qui per imparare

di Vecchio Frac data: 24/09/2013 14:52:33
Una variante ^_^

Function estrai(lista As Variant, num_estrazioni As Integer) As Variant
Dim i As Integer, k() As Long, r1 As Integer, r2 As Integer, tmp As Integer
'da una lista di numeri ordinata in modo casuale estrae il numero di estrazioni specificato
'restituisce Falso se si chiedono più estrazioni degli elementi contenuti
'for each k in estrai(array(1,2,3,4,5),3):?k;:next

    If num_estrazioni > UBound(lista) + 1 Or num_estrazioni <= 0 Then
        estrai = Array(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

di totygno71 (utente non iscritto) data: 24/09/2013 14:54:02
cit "Una variante ^_^

Ma quante ne sa quest'omino qui!!! ^_^

Vuoi Approfondire?