Excel Macro - Rows to Comma Separated Cells (Preserve/Aggregate Column)

后端 未结 2 1425
面向向阳花
面向向阳花 2020-12-12 05:39

Based on this Data:

    <- A (Category) ->   <- B (Items) -> 
1   Cat1                 a
2   Cat1                 b
3   Cat1                 c
4          


        
相关标签:
2条回答
  • 2020-12-12 06:17

    You may try this:

    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
    
    0 讨论(0)
  • 2020-12-12 06:21

    If you want to keep your original data and merely summarize the data somewhere else, you can use the following method.

    Create a user-defined function in VB that is essentially just like CONCATENATE, but can be used in an array formula. This will allow you to stick an IF statement in for the range variable in the CONCATENATE function. Here's a quick version I threw together:

    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
    

    So you could use the following in this table to summarize Items:

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

    Remember to press Ctrl+Shift+Enter when entering the formula.

    0 讨论(0)
提交回复
热议问题