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

问题

Based on this Data:

    <- 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

I need this:

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

回答1:

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.

回答2:

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

来源：https://stackoverflow.com/questions/5502248/excel-macro-rows-to-comma-separated-cells-preserve-aggregate-column

标签

excel

vba