Макросом быстрее будет. Запускать на каждом отдельном листе:
Код:
Sub Sort_Goods_and_Sizes()
Dim totalrows, Row, i As Long
Application.ScreenUpdating = False
totalrows = ActiveSheet.UsedRange.Rows.Count
Range(Cells(2, 1), Cells(totalrows, 2)).Sort Key1:=Cells(2, 1), Order1:=xlDescending, _
Key2:=Cells(2, 2), Order2:=xlDescending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
For Row = totalrows To 3 Step -1
If Cells(Row, 1) = Cells(Row - 1, 1) _
And Cells(Row, 2) = Cells(Row - 1, 2) Then
Rows(Row).EntireRow.Delete
End If
Next Row
totalrows = ActiveSheet.UsedRange.Rows.Count
i = 1
For Row = totalrows To 2 Step -1
If Cells(Row, 1) = Cells(Row - 1, 1) Then
Cells(i, 3) = Cells(Row, 1)
Cells(i, 4) = Cells(i, 4) & Cells(Row, 2) & ", "
Else
Cells(i, 3) = Cells(Row, 1)
Cells(i, 4) = Cells(i, 4) & Cells(Row, 2)
i = i + 1
End If
Next Row
Columns(2).EntireColumn.Delete
Columns(1).EntireColumn.Delete
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub