VBA将新集合输出到单个单元格

Question

我需要从特定单元格中的范围中获取唯一值 A1 = x，A2 = y，A3 = z，A4 = x
我想得到B1 = x，y，z
我的解决方案是：
在B2中连接A1，A2，A3，A4 拆分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

你可以使用后期绑定＆＃34;在飞行中＆＃34; 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