VBA Вывод новой коллекции в одну ячейку

Question

Мне нужно получить уникальные значения из диапазона, в определенной ячейке.
A1 = х, А2 = у, A3 = Z, A4 = х
Я хочу, чтобы получить B1 = х, у, г
Мое решение:
конкатенации A1, A2, A3, A4, в В2.
раздел B2.
новый коллекция из разделенный B2.
элементы сбора выходного в C1, C2, ..Ci
конкатенации C1, C2, .. Ci в B1

можно избежать сбору вывода в C1, C2? но выводить непосредственно в B1 через какую-то переменную?

''''''' 
concatenation part  
'''''''' 
    Dim ary As Variant 
    Dim Arr As New Collection, a 
    Dim i As Long 
    ary = split(Range("b2"), ",") 

    For Each a In ary 
    Arr.Add a, a 
    Next 

    For i = 1 To Arr.count 
    Cells(1, i+2) = Arr(i) ' output collection in some cells 
    Next 
    ''''''''''''''''''''''''' 
concatenation part 
''''''''''' 

спасибо.

Answer 1

вы могли бы использовать позднее связывание "на лету" Dictionary объект:

Sub main() 
    Dim cell As Range 

    With CreateObject("Scripting.Dictionary") 
     For Each cell In Range("A1:A4") '<--| change "A1:A4" to whatever range you need 
      .Item(cell.Value) = .Item(cell.Value) + 1 
     Next cell 
     Range("B1").Value = Join(.keys, ",") 
    End With 
End Sub 

Answer 2

в массиве, split снова, spit(a,"=") добавляя индекс 1 в другой массив, а не сборник, а затем использовать JOIN положить его обратно вместе

x=0 
redim arrOutput(ubound(ary)) 
For Each a In ary 
    arrOutput(x)= split(a,"=")(1) 
    x=x+1 
Next 

range("b1")=join(arrOutput,",") 

или просто разделить с помощью = и принимать нечетные числа из полученного в результате массив может быть?

Answer 3

Если вам нужно провести что-то уникальное - всегда думайте о словаре, причина метода Exists. Вот небольшой пример:

Sub test() 
    Dim NonUniqueValues As Variant 
    Dim UniqueValues As Object 
    Dim i As Long 

    'gather source array 
    NonUniqueValues = Union([A1], [A2], [A3], [A4]).Value2 

    'set dict 
    Set UniqueValues = CreateObject("Scripting.Dictionary") 

    'loop over array 
    For i = LBound(NonUniqueValues, 1) To UBound(NonUniqueValues, 1) 
     If Not UniqueValues.Exists(NonUniqueValues(i, 1)) Then _ 
       Call UniqueValues.Add(Key:=NonUniqueValues(i, 1), Item:=NonUniqueValues(i, 1)) 
    Next 

    'output 
    [B1] = Join(UniqueValues.Keys, ",") 

End Sub 

Answer 4

Возможно:

Public Function KonKat(rng As Range) As String 
    Dim c As Collection, r As Range, i As Long 

    Set c = New Collection 
    On Error Resume Next 
     For Each r In rng 
      c.Add r.Value, CStr(r.Value) 
     Next r 
    On Error GoTo 0 

    For i = 1 To c.Count 
     KonKat = KonKat & "," & c.Item(i) 
    Next i 
     KonKat = Mid(KonKat, 2) 
End Function