Função para retirar repetidos de célula

Objetivo: Retornar apenas valores sem repetição a partir de uma célula usando uma função criada com VBA.

Esta função foi criada para auxiliar o leitor Hélio Santos Júnior em um problema que são retirados dados de planilhas aonde são realizadas várias medições, porém, estas planilhas retornam valores duplicados em determinadas situações e para subir as informações para o sistema da empresa ele precisa que sejam apenas valores sem duplicação.

Para isso foi criada a seguinte lógica:

'Função que identifica se há repetidos
Public Function lfRepetidosB(ByVal lRange As Range, ByVal lSeparador As String) As Variant

    'Esta instrução faz com que ao tentar inserir um valor duplicado na coleção ele pule para o próximo registro
    On Error Resume Next

    'Recalcula a função automaticamente
    Application.Volatile

    Dim lCel     As Range
    Dim lValores As Variant
    Dim lValor   As Variant
    Dim lUnicos  As New Collection
    Dim i        As Long

    i = 0

    'A função split faz com que os valores sejam separados a partir de um determinado separador, no caso do problema apresentado o separador é
    'espaço, " "
    lValores = Split(lRange, lSeparador)

    'O comando For Each varre a coleção de valores, podendo ser utilizado em Variant ou em Collection
    For Each lValor In lValores
        lUnicos.Add lValores(i), CStr(lValores(i))
        i = i + 1
    Next lValor

    On Error GoTo 0

    i = 1

    'Junta as informações e retorna na função
    While i <= lUnicos.Count
        lfRepetidosB = lfRepetidosB + " " + lUnicos.Item(i)
        i = i + 1
    Wend
End Function

Para determinar esta função como global você pode seguir os passos do artigo Criando Funções Próprias Globais.

Para chamar a função você deve passar os seguintes parâmetros:

=lfRepetidosB(Endereço; Delimitador)

Endereço: a célula que você quer retirar os repetidos, deve ser uma única célula.

Delimitador: o campo que separa as informações, no caso do exemplo é " ". (Espaço)

Exemplo: =lfRepetidosB(A1; " ")

Abraço

Marcos Rieper