segunda-feira, 26 de julho de 2010

função recebe um vetor como parâmetro e retorna esse vetor sem elementos repetidos

Function UniqueVet(V1 As Variant) As Variant
'#### Essa função recebe um vetor como parâmetro
'#### e retorna esse vetor sem elementos repetidos

On Error Goto Ops

Dim V2() As String
Dim CountV2 As Integer
CountV2 = 0
Redim Preserve V2( 0 To 0 )

' Para cada elemento do vetor recebido...
For i%=0 To Ubound(V1)
FlagI% = 0
'Até que v1 seja igual a v2 ou v2 chegue ao fim
For j%=0 To Ubound(V2)
If(V1(i%)=V2(j%))Then
FlagI% = 1
Exit For
End If
Next
If FlagI%=0 Then
Redim Preserve V2( 0 To CountV2 )
V2(CountV2) = V1(i%)
CountV2 = CountV2 + 1
End If
Next
UniqueVet = V2

Exit Function

Ops:
Messagebox "Error na functino UniqueVet - " & Str(Err) & ": " & Error & " - line: " & Erl
End Function

Nenhum comentário:

Postar um comentário