Detalhes de vba duplicados copiando valores nao duplicados

PropriedadeValor
Nome:vba duplicados copiando valores nao duplicados
Descricao:

Essa macro do Aplicativo Microsoft Excel VBA, juntamente com uma função retornam valores únicos em determinada coluna coluna,
observe que a macro copia para coluna(B) valores únicos existentes na coluna(A), valores não duplicados.


Sub Copiar_valores_unicos()
Dim coll As Collection, i As Long
Set coll = RetornaValorUnico(Range("A1:A100"))
If coll Is Nothing Then Exit Sub

Range("C1:C100").Clear
For i = 1 To coll.Count
Range("C1").Offset(i - 1, 0).Formula = coll(i)
Next i
End Sub



Function RetornaValorUnico
(KeyRange As Range, Optional ItemRange As Range) As Collection
Dim r As Long, c As Long, varItem As Variant, strKey As String
If Not KeyRange Is Nothing Then
Set RetornaValorUnico = New Collection
With KeyRange
For c = 1 To .Columns.Count
For r = 1 To .Rows.Count
strKey = vbNullString
varItem = vbNullString

On Error Resume Next
strKey = Trim(CStr(.Cells(r, c).Value))

If Not ItemRange Is Nothing Then
varItem = ItemRange.Cells(r, c).Value
Else
varItem = .Cells(r, c).Value
End If

If Len(strKey) > 0 Then
RetornaValorUnico.Add varItem, strKey
End If
On Error GoTo 0
Next r
DoEvents
Next c
End With
If RetornaValorUnico.Count = 0 Then
Set RetornaValorUnico = Nothing
End If
End If
End Function

 

Sub limpar_teste()
[C:C].ClearContents
End Sub


Aprenda Aplicativo Microsoft Excel VBA com SaberExcel - o site das macros


Nome do arquivo:vba duplicados copiando valores nao duplicados.zip
Tamanho: Vazio
Tipo:zip (Tipo de Mime: application/zip)
Autor:SaberExcel
Criado em: 21/11/2010 08:35
Visitas:Todos
Responsavel:Editor
Acessos:1199 Acessos
Atualizado em: 21/11/2010 08:35
Site: