Ci scrivono:

Buonasera, io dovrei estrarre, casualmente, da una colonna di 170 celle 40 celle. Mi potreste dare info su la funzione da utilizzare ? Grazie

<!–more–>

Risposta:

Dopo aver indicato nella cella D1 il numero di valori che voglio estrarre dal mio elenco
basta premere il bottone “ESTRAI” che esegue il seguente codice (commentato):

Public Sub EstraiCelleDaElenco()

Dim arr As New Collection
Dim i As Long
Dim IndiceCasuale As String

Dim DA_ESTRARRE As Integer
DA_ESTRARRE = Sheet1.Range("D1")


'---------------------------------------------------------------------------------------'
'Pulisco colonna dove estrarre i numeri

Sheet2.Select
Last_Row2 = Sheet2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

If Last_Row2 > 1 Then
   Sheet2.Range(Cells(2, 1), Cells(Last_Row2, 1)).ClearContents
End If
'---------------------------------------------------------------------------------------'

 
'Individuo ultima riga non vuota dell'elenco

MAX = Sheet1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Definisco intervallo inferiore (indice della prima riga contente i dati)
MIN = 2  'é la riga del primo elemento dell'elenco


'Ripeto il ciclo DO-LOOP fino a quando il numero di elementi contenuti nel vettore 'arr'
'è uguale al numero degli elementi da estrarre 'DA_ESTRARRE

Do Until arr.Count = DA_ESTRARRE
'estraggo un numero da inserire in un vettore
   IndiceCasuale = Int((MAX - MIN + 1) * Rnd + MIN)
'Se il numero fosse già presente nel vettore, non sarebbe possibile inserirlo e si genererebbe un errore.
'Ottengo quindi il risultato voluto (estrazione senza ripetizione)
'e faccio riprendere il ciclo
On Error Resume Next
arr.Add IndiceCasuale, IndiceCasuale

Loop
 

For i = 1 To arr.Count

'Ricalcolo l'ultima riga vuota del foglio in cui estrarre i dati
Last_Row2 = Sheet2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Copio nel foglio ESTRAZIONE i valori del foglio DATI
'utilizzando i numeri di riga casuali estratti precedentemente ed inseriti nel vettore arr
'di cui prendo gli gli elementi 'i' dal numero 1 all'ultimo arr.Count

 Sheet2.Cells(Last_Row2 + 1, 1) = Sheet1.Cells(arr(i), 1)

Next

End Sub

A voi il file:
APRI

Riccardo Vincenti