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
