(Excel) 如何自动创建逗号分隔列表？ [关闭]

Question

我承认 Excel 远非我的强项，因此我们将不胜感激。

我们在 Excel 电子表格中有大量数据（约 15,000 行）需要报告。

对于 A 列中的每一项，B 列中都有一个或多个值。

下表描述了我的意思，尽管规模很小：

有没有办法让 Excel 在这样的表中运行，并为 A 列中的每个唯一值，为 B 列中的每个对应值编译一个逗号分隔的列表。

即

提前感谢您的帮助。

Answer 1

这是给andy的：

使用数组公式：

=TEXTJOIN(",",TRUE,IF(A1:A7="andy",B1:B7,""))

数组公式必须使用 Ctrl + Shift + Enter 而不仅仅是 Enter 键。如果正确执行此操作，公式将在公式栏中显示并带有花括号。

为每个唯一名称重复该公式。

编辑#1：

自动化：

1. 将列 A 复制到列 C
2. 使用 Excel 的 RemoveDuplicates 功能创建唯一名称列表
3. 将数组公式应用于该唯一列表的每个成员。

编辑#2：

要使用 VBA 实现自动化，请运行这个简短的宏：

Sub PleaseAutomate()
        Dim N As Long
        Dim M As Long

        M = Cells(Rows.Count, "A").End(xlUp).Row
        Columns(1).Copy Columns(3)
        Columns(3).RemoveDuplicates Columns:=1, Header:=xlNo
        N = Cells(Rows.Count, "C").End(xlUp).Row
        Range("D1").FormulaArray = "=TEXTJOIN("","",TRUE,IF($A$1:$A$" & M & "=C1,$B$1:$B$" & M & ",""""))"
        Range("D1").Copy Range("D2:D" & N)
End Sub

Answer 2

这将处理您的整个数据集。查看 cmets 并在它指定的两个位置更新您的范围。老实说，您的数据是从哪里提取的？我假设一个数据库。您可能应该在数据馈送中处理此问题

Public Sub ValuestoStringSeparated()
    Dim Data As Variant, Results As Variant, tmp As Variant
    Dim Dict As Object
    Dim i As Long
    Dim Key

    Set Dict = CreateObject("Scripting.Dictionary")

    ' Update this to your sheet Ref
    With ActiveSheet
        Data = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)).Value2
    End With

    ' Add your raw data to Dictionary
    For i = LBound(Data, 1) To UBound(Data, 1)
        If Not Dict.Exists(Data(i, 1)) Then
            ReDim tmp(0)
            tmp(0) = Data(i, 2)
            Dict.Add Key:=Data(i, 1), Item:=tmp
        Else
            tmp = Dict(Data(i, 1))
            ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
            tmp(UBound(tmp)) = Data(i, 2)
            Dict(Data(i, 1)) = tmp
        End If
        Erase tmp
    Next i

    ' Print your Data to sheet
    ReDim Results(1 To Dict.Count, 1 To 2)
    i = 0
    For Each Key In Dict.keys
        i = i + 1
        Results(i, 1) = Key
        Results(i, 2) = Join(Dict(Key), ", ")
    Next Key

    ' Update with your desired output destination
    With ActiveSheet.Range("D2")
        .Resize(UBound(Results, 1), UBound(Results, 2)).Value2 = Results
    End With
End Sub

Answer 3

通过字典和数据字段数组的方法

类似于上面@Tom 的好解决方案:+)，但加入字典中已经存在的保险类型并避免使用额外的 tmp 数组的常量ReDim Preserve。 注意：我决定使用计数器而不是正确的 LBound 和 UBound 计数以提高可读性，从而也可以轻松定义范围。

代码

Option Explicit
Sub JoinTypes()
  Const DELI As String = ","
  Dim dict As Object, d
  Dim i    As Long, n As Long
  Dim sKey As String
  Dim v    As Variant, Results() As Variant
  Dim ws   As Worksheet
  Set ws = ThisWorkbook.Worksheets("Test")            ' << change to your sheet name
  Set dict = CreateObject("Scripting.Dictionary")     ' dictionary object

' [1] get last row in column A
  n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
' [2] read data into 1-based 2-dim datafield array
  v = ws.Range("A1:B" & n)
' [3] get Customers and collect joined values into dictionary (omit title row)
  For i = 2 To n
      sKey = v(i, 1)
      If dict.Exists(sKey) Then                 ' join insurance types (delimiter ",")
         dict(sKey) = dict(sKey) & DELI & v(i, 2)
      Else                                      ' start new customer
         dict.Add key:=sKey, Item:=v(i, 2)
      End If
  Next i
  Erase v
' [4] write joined values into new array
   n = dict.Count                               ' redefine counter
   ReDim Results(1 To n, 1 To 2)                ' redimension new array ONLY ONCE :-)
   i = 0
   For Each d In dict.keys                      ' loop through customers in dictionary keys
       i = i + 1: Results(i, 1) = d: Results(i, 2) = dict(d)
   Next d
 ' [5] write array back to sheet (e.g. column D:E omitting title row)
   ws.Range("D2:E" & n + 1) = Results
 ' [6] clear memory
   Set ws = Nothing: Set dict = Nothing
End Sub