Este fórum está sendo desativado

[LeandroAndrade]

Boa tarde

criei esta função para me retornar todos valores com um critério porém preciso eliminar os repetidos.

Function Lookup_concat(Search_string As String, _
Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim result As String

If Search_string = vbNullString Then
result = ""
Lookup_concat = Trim(result)
End
End If


For i = 1 To Search_in_col.Count
If Search_in_col.Cells(i, 1) = Search_string Then
result = result & "/" & Return_val_col.Cells(i, 1).Value
End If
Next

result = Right(result, Len(result) - 1)
Lookup_concat = Trim(result)

End Function

ela funciona me trazendo todos valores em uma celula somente com o critério desejado porem não elimina os repetidos.

[osvaldomp]

Olá, Leandro.

Experimente substituir este trecho

Código: Selecionar todos

For i = 1 To Search_in_col.Count
If Search_in_col.Cells(i, 1) = Search_string Then
result = result & "/" & Return_val_col.Cells(i, 1).Value
End If
Next

por este

Código: Selecionar todos

For i = 1 To Search_in_col.Count
 If Search_in_col.Cells(i, 1) = Search_string Then
  If Application.CountIf(Range(Search_in_col.Cells(1, 1), Search_in_col.Cells(i, 1)), Search_string) = 1 Then
   result = result & "/" & Return_val_col.Cells(i, 1).Value
  End If
 End If
Next

Se não resolver disponibilize a sua planilha e não imagem dela.

[babdallas]

Tente isso.

Function Lookup_concat(Search_string As String, _
Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim result As String
Dim unico As New Collection

If Search_string = vbNullString Then
result = ""
Lookup_concat = Trim(result)
End
End If

On Error Resume Next
For i = 1 To Search_in_col.Count
If Search_in_col.Cells(i, 1) = Search_string Then
unico.Add Return_val_col.Cells(i, 1).Value, Return_val_col.Cells(i, 1).Value & "a"
End If
Next
On Error GoTo 0

For i = 1 To unico.Count
result = result & "/" & unico.Item(i)
Next

result = Right(result, Len(result) - 1)
Lookup_concat = Trim(result)

End Function

[LeandroAndrade]

Galera deu Certinho Muito obrigado