Excel宏 - 行以逗號分隔細胞（保存/聚合列）在此基礎上的數據

Question

：

<- A (Category) -> <- B (Items) -> 
1 Cat1     a 
2 Cat1     b 
3 Cat1     c 
4 Cat2     d 
5 Cat3     e 
6 Cat4     f 
7 Cat4     g 

我需要這樣的：

<- A (Category) -> <- B (Items) -> 
1 Cat1     a,b, c 
2 Cat2     d 
3 Cat3     e 
4 Cat4     f, g 

Answer 1

你可以試試這個：

Sub GroupMyValues() 

    Dim oCell As Excel.Range 
    Dim sKey As String 
    Dim sResult As String 

    Set oCell = Worksheets(2).Range("A1") 

    While Len(oCell.Value) > 0 

     If oCell.Value <> sKey Then 

      'If first entry, no rows to be deleted 
      If sKey <> "" Then 

       oCell.Offset(-1, 1).Value = sResult 

      End If 

      sKey = oCell.Value 
      sResult = oCell.Offset(0, 1).Value 
      Set oCell = oCell.Offset(1, 0) 

     Else 

      sResult = sResult & ", " & oCell.Offset(0, 1).Value 

      Set oCell = oCell.Offset(1, 0) 
      oCell.Offset(-1, 0).EntireRow.Delete 

     End If 

    Wend 

    'Last iteration 
    oCell.Offset(-1, 1).Value = sResult 

End Sub 

Answer 2

如果您想保留您的原始數據並僅在其他地方彙總數據，則可以使用以下方法。

在VB中創建一個用戶定義的函數，它本質上就像CONCATENATE一樣，但可以在數組公式中使用。這將允許您在CONCATENATE函數中爲範圍變量插入IF語句。這裏有一個快速的版本我扔在一起：

Private Function CCARRAY(rr As Variant, sep As String) 
'rr is the range or array of values you want to concatenate. sep is the delimiter. 
Dim rra() As Variant 
Dim out As String 
Dim i As Integer 

On Error GoTo EH 
rra = rr 

out = "" 
i = 1 

Do While i <= UBound(rra, 1) 
    If rra(i, 1) <> False Then 
     out = out & rra(i, 1) & sep 
    End If 
    i = i + 1 
Loop 
out = Left(out, Len(out) - Len(sep)) 

CCARRAY = out 
Exit Function 

EH: 
rra = rr.Value 
Resume Next 

End Function 

所以，你可以使用下面這個表總結項目：

{=CCARRAY(IF(A1:A7="Cat1",B1:B7),", ")} 

記住按Ctrl + Shift +輸入公式時輸入。