объединить уникальные значения из диапазона в строку с разделителем (разделитель по умолчанию ";"):

Function JoinWithoutDuplicates(rng As Range, Optional sep As String = "; ") As String
Dim x, v, s As String
x = Intersect(rng, ActiveSheet.UsedRange).Value: s = sep
For Each v In x
 v = Trim$(v)
 If Len(v) Then If InStr(s, sep & v & sep) = 0 Then s = s & v & sep
Next
JoinWithoutDuplicates = Mid(s, Len(sep) + 1, Len(s) - Len(sep) * 2)
End Function

объединить уникальные из диапазона по искомому значению в строку с разделителем (что-то типа ВПР):

Public Function ertert(SearchValue, rng As Range, k As Long, Optional sep As String = "; ") As String 'напряженка с названиями :)
Dim x, v, s As String, i As Long
x = Intersect(rng, rng.Worksheet.UsedRange).Value: s = sep
For i = 1 To UBound(x)
 If x(i, 1) = SearchValue Then
 If Len(x(i, k)) Then
 If InStr(s, sep & x(i, k) & sep) = 0 Then
 s = s & x(i, k) & sep
 End If
 End If
 End If
Next i
If Len(s) > Len(sep) Then ertert = Mid(s, Len(sep) + 1, Len(s) - Len(sep) * 2)
End Function

пример в студии :)