Saberexcel - o site de quem precisa aprender Macros Microsost Excel VBA

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 tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

   Baixe o exemplo de planilha da macro e função acima
Excel planilha vba duplicados copiando valores nao duplicados (27.59 kB)