Durante la realizzazione del precedente articolo ‘071. Estrazione casuale valori da un elenco’
ho pensato ad una variante del codice che permettesse di estrarre dei numeri
dopo aver definito il valore minimo e massimo della serie di numeri da cui estrarre,
ed il numero di valori da estrarre.

Questo è il codice:

Public Sub EstraiNumeri()

  Dim arr As New Collection
  Dim i As Long
  Dim IndiceCasuale As String
  
  Dim MAX, MIN, DA_ESTRARRE As Integer
  
  MIN = Sheet1.Range("D1")
  MAX = Sheet1.Range("F1")
  DA_ESTRARRE = Sheet1.Range("I1")
  
  
  If DA_ESTRARRE > (MAX - MIN) Then
      MsgBox "I numeri da estrarre devono essere meno di " & (MAX - MIN) + 1, vbCritical, "Attenzione"
      Exit Sub
  End If
  
  
  '---------------------------------------------------------------------------------------'
  'Pulisco colonna dove estrarre i numeri
  Last_Row = Sheet1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
  If Last_Row > 1 Then
     Sheet1.Range(Cells(2, 1), Cells(Last_Row, 1)).ClearContents
  End If
  '---------------------------------------------------------------------------------------'
  
  
  '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
  
  
  IndiceCasuale = Int((MAX - MIN + 1) * Rnd + MIN)
 
  On Error Resume Next
  'Se il numero fosse già presente, non sarebbe possibile inserirlo nel vettore e si genererebbe un errore
  'ottengo quindi il risultato voluto (estrazione senza ripetizione)
  'i riprendo il ciclo
  arr.Add IndiceCasuale, IndiceCasuale

  Loop

  For i = 1 To arr.Count
      'riporto nel foglio 'ESTRAZIONE' i numeri casuali precedentemente inseriti nel vettore arr
      'di cui prendo gli gli elementi 'i' dal numero 1 all'ultimo arr.Count
     Cells(i + 1, 1) = arr(i)
  Next


End Sub

A voi il file:
APRI

Riccardo Vincenti

The following two tabs change content below.

• Bio
• Ultimi Post

Riccardo Vincenti

Ultimi post di Riccardo Vincenti (vedi tutti)

• 073. Duplicare righe excel modificando il contenuto - 6 Ottobre 2017
• 072. Estrazione numeri casuali - 6 Ottobre 2017
• 071. Estrazione casuale valori da un elenco - 5 Ottobre 2017
• 070. Contare dati univoci senza Pivot - 21 Settembre 2017
• 069. Aggiungere intervalli ad una data: Date Add in Excel - 21 Settembre 2017

This work by Riccardo Vincenti is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International