Excel宏 - 行到逗号分隔单元格(保留/聚合列)

时间:2011-03-31 15:22:09

标签: excel vba

基于此数据:

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

2 个答案:

答案 0 :(得分:3)

如果您想保留原始数据并仅将数据汇总到其他地方,可以使用以下方法。

在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 + Enter。

答案 1 :(得分:2)

你可以试试这个:

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