Como combinar várias linhas de dados de um único cliente em uma célula como valores separados por vírgula?

Question

Eu tenho um relatório de tabela PIVOT como o abaixo:

Customer Name   Category  Date Met
-----------------------------------
Customer 1       Core        9
                             10

Customer 2       VIP         2
                             12
                             23

Posso obter a seguinte saída por qualquer meio na tabela dinâmica (excel 2007)?

Customer Name   Category   Date Met
Customer 1      Core       9,10
Customer 2      VIP        2, 12, 23

    

Answer 1

Esta macro fará isso sem o loop usando uma coluna vazia à direita ... para referência, a fórmula sendo colocada em D2 e copiada é:

= IF ($ C3="", $ C2, IF ($ A3="", $ C2 & "," & $ D3, $ C2))

Sub ReduceRows()
Dim LR As Long

LR = Range("C" & Rows.Count).End(xlUp).Row

With Range("D2:D" & LR)
    .FormulaR1C1 = "=IF(R[1]C3="""", RC3, IF(R[1]C1="""", RC3&"",""&R[1]C4, RC3))"
    .Value = .Value
    .Copy Range("C2")
    .ClearContents
End With

Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

    

Answer 2

Este VBA fará o que você quiser, mas não é uma tabela dinâmica

Sub test()
'define variables
Dim RowNum as long, LastRow As long
'turn off screen updating
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A2", Cells(LastRow, 3)).Select
'For loop for all rows in selection with cells
For Each Row In Selection
    With Cells
    'if date isn't blank
    If Cells(RowNum, 3) <> "" Then
        'and if customer name blank
        If Cells(RowNum, 1) = "" Then
            'and if category blank
            If Cells(RowNum, 2) = "" Then
                'concatenate and delete empty line
                Cells(RowNum - 1, 3) = Cells(RowNum - 1, 3) & ", " & Cells(RowNum, 3)
                Rows(RowNum).EntireRow.Delete
                'since we deleted a row, go back a row
                RowNum = RowNum - 1
            End If
        End If
    End If
    End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True

End Sub

e sim, reutilizei alguns dos meus códigos de este problema