Ti posto un function che serve per eliminare i duplicati in un vettore che ho copiato da un libro io l'ho provata funziona correttamente:
codice:
Dim VettAppo1()
'esempio di vettore con duplicati
VettAppo1 = Array("a", "b", "c", "d", "a", "a")
'richiami la function e al termine in VettAppo1 non hai più duplicati
dups = FilterDuplicates(VettAppo1())
Function FilterDuplicates(arr As Variant) As Long
Dim col As Collection, index As Long, dups As Long
Set col = New Collection
On Error Resume Next
For index = LBound(arr) To UBound(arr)
'costruisci la chiave usando l'elemento dell'array
'avviene un errore se la chiave esiste già
col.Add 0, CStr(arr(index))
If Err Then
'abbiamo trovato un duplicato
arr(index) = Empty
dups = dups + 1
Err.Clear
ElseIf dups Then
'abbiamo trovato uno o più duplicati
' dobbiamo spostare gli elementi verso gli indici più bassi
arr(index - dups) = arr(index)
arr(index) = Empty
End If
Next
'restituisci il numero dei duplicati se ti interessa
FilterDuplicates = dups
End Function
Ciao, spero possa esserti utile
Rispondi quotando
Boolean
