Etrazione di dati univoci

Ultima modifica: 30-05-2016

Una normale routine per estrarre dati univoci

In questa routine facciamo uso di una normale scansione tabellare con relativi confronti dato per dato per controllare se esistono dati replicati.

Dopo le prime righe che servono ad inizializzare le variabili di servizio passiamo nel corpo del codice per estrarre dati univoci da un elenco dove i dati sono ripetuti.

Nel nostro esempio i dati da estrapolare si trovano nella prima colonna del Foglio (la colonna A) ed i dati estrapolati li depositiamo nella 5^ colonna (la colonna E)

Istruiamo un primo ciclo per spazzolare l'intera tabella.
Se la riga puntata da questo ciclo non ha già un segnaposto provvediamo a mettercene uno, copiamo il dato in un'altra zona (lo potremmo memorizzare anche in una matrice per eventuali ulteriori elaborazioni) ed istruiamo un secondo ciclo per esplorare il resto della tabella e con questo provvediamo a porre un segnaposto là dove incontriamo un dato uguale a quello puntato dal ciclo esterno. Con questo sistema otteniamo che, quando il ciclo esterno si troverà ad esaminare questi dati già contrassegnati, andrà avanti di un altro passo senza altro fare.

Sub ElencoUnivoco()
Dim FL As Boolean
Dim R, C, R1, C2, Uriga, Col, R2
Worksheets("Foglio2").Select
Uriga = Range("A1").End(xlDown).Row
Col = 1
R2 = 2: C2 = 5

For R = 2 To Uriga
'il codice scritto qui sotto viene eseguito solo se le righe non
'sono state precedentemente esaminate (non contengono il segnaposto "*")
If Cells(R, Col + 1) = "" Then
'viene fissato il segnaposto
Cells(R, Col + 1) = "*"
'viene copiato nella 5^ colonna il dato trovato privo di segnaposto
Cells(R2, C2) = Cells(R, 1)
R2 = R2 + 1
'comincio il confronto nell'elenco sottostante
For R1 = R + 1 To Uriga
'se i due dati esaminati sono uguali
If Cells(R, 1) = Cells(R1, 1) Then
'viene posto un nuovo segnaposto nella riga puntata da R1
Cells(R1, Col + 1) = "*"
End If
Next
End If
'terminati i confronti viene incrementato il contatore del primo ciclo
Next

'finito il lavoro cancelliamo i segnaposti oramai inutili
For R = 2 To Uriga
Cells(R, Col + 1) = ""
Next
End Sub