Как объединить несколько строк данных одного клиента в ячейку в виде значений, разделенных запятыми?

Question

У меня есть отчет таблицы PIVOT, как показано ниже:

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

Customer 2       VIP         2
                             12
                             23

Можно ли каким-либо образом получить следующий вывод в сводной таблице (Excel 2007)?

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

Answer 1

Этот макрос будет делать это без зацикливания, используя пустой столбец справа ... для справки, формула помещается в D2 и копируется так:

= 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

Этот VBA будет делать то, что вы хотите, но это не сводная таблица

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

и да, я действительно использовал часть своего кода из этой проблемы