Questo sito utilizza cookie, anche di terze parti, per migliorare la tua esperienza e offrire servizi in linea con le tue preferenze. Chiudendo questo banner, scorrendo questa pagina o cliccando qualunque suo elemento acconsenti all’uso dei cookie

Rimani informato sugli aggiornamenti di SOS-OFFICE. Inserisci il tuo indirizzo e-mail: Informativa sulla privacy

Ricerca casuale in tabella

Vai
6 Anni 7 Mesi fa #173 da MrFama
COM_KUNENA_MESSAGE_CREATED_NEW
Salve,
sono un nuovo iscritto ed avrei bisogno del vostro aiuto.

Ho costruito una tabella in cui, sul foglio “Elenco Personale”, suddivisa in n colonne ed n righe (vedi esempio):
NomeCognomeMoto
ValentinoRossiYamaha
MarcMarquezHonda
DaniPedrosaHonda

Sul foglio “Estrazione” voglio estrarre in maniera casuale 20/25 nominativi con tutte e tre le informazioni inerenti quel determinato pilota.
Al momento, per estrarre i dati in maniera casuale utilizzo questo codice (che mi permette di ricavare i dati della colonna “A”):
Sub lavoratore()
    FNomi = "Elenco Personale"      '<<<<< Foglio con i nominativi
    FEstraz = "Estrazione"    '<<<<< Foglio per le estrazioni
 
    Sheets(FNomi).Select
    TotNomi = Range("A65536").End(xlUp).Row - Range("Inizio").Row + 0
    Sheets(FEstraz).Select
    Range("A:B").ClearContents
    For I = 1 To Worksheets("Estrazione").Range("F1")
AncoRand:
    NumRand = Int((TotNomi) * Rnd)
    If Application.WorksheetFunction.CountIf(Range("A1:A1000"), NumRand) > 0 Then GoTo AncoRand
    Range("A65536").End(xlUp).Offset(1, 0).Value = NumRand
    Range("A65536").End(xlUp).Offset(0, 1).Value = Range("Inizio").Offset(NumRand, 0).Value
    Next I
    End Sub

Per poter associare anche gli altri due parametri, per ciascun pilota, come posso risolvere.
Vi ringrazio fin d’ora per qualsiasi aiuto vogliate fornirmi.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #174 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
Ciao
per cominciare, semplificherei un po' il tuo codice.
Vedi se questo ti aiuta

Sub casualeCopia()
Dim ultima As Integer
Dim prima As Integer
Dim casuale As Integer

ultima = Range("A1").End(xlDown).Row
prima = 2


Worksheets(2).Select
Range("A:B").ClearContents
Range("a1").Select

For i = 1 To 5
casuale = Int((ultima - prima + 1) * Rnd() + prima)
Range("a" & i) = Worksheets(1).Cells(casuale, 1)
Range("b" & i) = Worksheets(1).Cells(casuale, 2)
Range("c" & i) = Worksheets(1).Cells(casuale, 3)
Next
End Sub

Tieni conto che per estrarre un numero casuale che ricada in un intervallo si procede così

(valoreMassimo-valoreMinimo +1) * Rnd() + valoreMinimo
se poi vuoi un numero intero, dai tutto in pasto alla funzione Int.

Fammi sapere come è andata

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #175 da MrFama
COM_KUNENA_MESSAGE_REPLIED_NEW
Ciao Alessandra,
grazie per aver risposto.
Ho inserito subito il tuo codice al posto del precedente e la risposta è stata:
Errore di run-time '6':

Overflow

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #176 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
non so dove stava il tuo codice precedente, nè che formato excel usi (xls o xlsx), nè quante sono le tue righe piene della colonna A.

Allegato estrazionecasuale.xlsm non trovato



Ti allego il file dove ho scritto il codice.
A me funziona senza dare errori.

Questo messaggio ha un file allegato.
Accedi o registrati per visualizzarlo.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #177 da MrFama
COM_KUNENA_MESSAGE_REPLIED_NEW
Non so perché a te funziona e nel mio no, comunque si tratta di un file composto da circa 600 voci a colonna.
Il formato del file è un xlsm ed il codice è inserito in un modulo, esattamente come hai fatto tu.
Ti ringrazio per avermi mostrato il file che hai creato ma ho notato subito che non mostra voci univoche (cioè ripetizioni nelle estrazioni).
Ti allego il mio file di esempio.

Allegato Test.xlsm non trovato

Questo messaggio ha un file allegato.
Accedi o registrati per visualizzarlo.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa - 6 Anni 7 Mesi fa #178 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
cancella la formattazione delle celle che impiccia.
Per la questione degli univoci (che non avevi specificato) la cosa si fa più complessa.
Ora non riesco a farlo perchè devo scappare.
Poi quando torno, ti dico.
Last edit: 6 Anni 7 Mesi fa by Alessandra.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #179 da MrFama
COM_KUNENA_MESSAGE_REPLIED_NEW
E lo so che la cosa si complica, la ha complicata anche a me (scusa se non lo avevo specificato ma....nella mia testa..lo davo per scontato. Perdono :cheer: ).
Resto in trepidante e paziente attesa del tuo prezioso aiuto.

Ciao

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #180 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
eccomi.
Con un po' di cicli e array ci si riesce.
Io ho usato questa routine

Sub estrai()

Dim iArr As Variant

Dim i As Integer

Dim casuale As Integer

Dim temp As Integer
Dim estratto As Integer
Dim prima As Integer
Dim ultima As Integer
Dim estrazioni As Integer

prima = 2
ultima = Worksheets(1).Range("A1").End(xlDown).Row
estrazioni = 25

ReDim iArr(prima To ultima)

For i = prima To ultima
iArr(i) = i
Next i



For i = ultima To prima + 1 Step -1
casuale = Int((ultima - prima + 1) * Rnd() + prima)
temp = iArr(casuale)
iArr(casuale) = iArr(i)
iArr(i) = temp
Next i



For i = prima To prima + estrazioni - 1

estratto = iArr(i)
Worksheets(2).Cells(i - 1, 1) = Worksheets(1).Cells(estratto, 1)
Worksheets(2).Cells(i - 1, 2) = Worksheets(1).Cells(estratto, 2)
Worksheets(2).Cells(i - 1, 3) = Worksheets(1).Cells(estratto, 3)

Next i

Worksheets(2).Activate
Range("a1").Select
End Sub

Vedi se è quello che fa al caso tuo

Allegato estrazionecasuale2.xlsm non trovato

Questo messaggio ha un file allegato.
Accedi o registrati per visualizzarlo.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #181 da MrFama
COM_KUNENA_MESSAGE_REPLIED_NEW
Sto guardando il file che mi hai mandato e vorrei porti alcune domande, per cercare di capirci qualcosa (vista la mia ignoranza in materia).
Guardando il modulo si vede che al codice che io ho postato inizialmente, tu hai aggiunto la tua parte di codice e tutto sembra funzionare perfettamente.
Ieri, per cercare di capire perché a te funzionasse e a me no ho provato a copiare "tutto" il codice del tuo modulo e creando una nuova tabella ho incollato tale codice e, sorpresa, continua a darmi errore di debug.
Come mai? :ohmy: :ohmy: :ohmy: :ohmy:
Davvero non riesco a capire quale sia la differenza

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa - 6 Anni 7 Mesi fa #182 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
io la tua parte di codice l'ho copiata solo per provarla, ma non serve a niente
Secondo me ti dà l'errore se lanci il vecchio codice da un foglio vuoto e quando fia xlEnd non ottieni niente di utile.

Ora non dovrebbe più farlo perchè ho scritto il foglio da usare nel codice, prova di nuovo.
Last edit: 6 Anni 7 Mesi fa by Alessandra.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #183 da MrFama
COM_KUNENA_MESSAGE_REPLIED_NEW
perciò il tasto si collega solo alla macro che hai scritto tu e non a tutto....
quindi la linea che separa i due codici è come se chiudesse la macro che ho scritto io e aprisse la tua (ma come faccio ad inserirla per non scrivere sempre più moduli (così come nel file che ti ho mandato?)

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #184 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
esatto.
La riga si crea da sola, quando scrivi una routine nuova.
Però permettermi di consigliarti di studiare i rudimenti di VBA altrimenti farai molta fatica a capire i codici

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 7 Mesi fa #185 da MrFama
COM_KUNENA_MESSAGE_REPLIED_NEW
Ecco...vedi :cheer: quindi chiudo la macro...inizio a scriverne una nuova e compare da sola :dry: non lo avrei mai capito ahahahahah
E' nelle mie intenzioni infatti....ed ho già un paio di libri da cui, al momento, estrapolo qualcosa che possa aiutarmi nei miei "danni" lavorativi.
Ti ringrazio per il prezioso aiuto che mi hai fornito, le dritte e non ultimo il suggerimento e sicuramente avremo modo di sentirci ancora.....con altre mie richieste di aiuto :P

Si prega Accedi o Crea un account a partecipare alla conversazione.

Tempo creazione pagina: 0.422 secondi
Powered by Forum Kunena
Joomla templates by a4joomla