Есть таблица из 10 колонок, 1 и 2 колонка- количество, чтобы сделать "сводную таблицу" вручную (т.к. не нашел как убрать "merge" из настоящей сводной таблицы) получился вот такой длиный "Sub"!!!
Все одинаковые наименования объединяются и суммируются, пустые строки удаляются!
Может кто знает более рациональное решение?
------------------------------------------------------
Sub Optim()
Dim i As Integer
Dim j As Integer
For i = 4 To 51
For j = i + 1 To 51
If (IsEmpty(Sheet1.Cells(j, 1))) And (IsEmpty(Sheet1.Cells(j, 2))) Then
GoTo 10
End If
'-----------------------------------------------------------
If (Sheet1.Cells(i, 3) = Sheet1.Cells(j, 3)) _
And (Sheet1.Cells(i, 4) = Sheet1.Cells(j, 4)) _
And (Sheet1.Cells(i, 5) = Sheet1.Cells(j, 5)) _
And (Sheet1.Cells(i, 6) = Sheet1.Cells(j, 6)) _
And (Sheet1.Cells(i, 7) = Sheet1.Cells(j, 7)) _
And (Sheet1.Cells(i, 8) = Sheet1.Cells(j, 8)) _
And (Sheet1.Cells(i, 9) = Sheet1.Cells(j, 9)) _
And (Sheet1.Cells(i, 10) = Sheet1.Cells(j, 10)) Then
'-----------------------------------------------------
Sheet1.Cells(j, 3) = 0
Sheet1.Cells(j, 4) = 0
Sheet1.Cells(j, 5) = 0
Sheet1.Cells(j, 6) = 0
Sheet1.Cells(j, 7) = 0
Sheet1.Cells(j, 8) = 0
Sheet1.Cells(j, 9) = 0
Sheet1.Cells(j, 10) = 0
Sheet1.Cells(i, 1) = Sheet1.Cells(i, 1) + Sheet1.Cells(j, 1)
Sheet1.Cells(i, 2) = Sheet1.Cells(i, 2) + Sheet1.Cells(j, 2)
Sheet1.Cells(j, 1) = 0
Sheet1.Cells(j, 2) = 0

10 End If
Next j
Next i
'===========================================================
For i = 4 To 51
If Sheet1.Cells(i, 1) = 0 Then
For j = i + 1 To 51
If Not Sheet1.Cells(j, 1) = 0 Then
'-----------------------------------------------------------
Sheet1.Cells(i, 1) = Sheet1.Cells(j, 1)
Sheet1.Cells(i, 2) = Sheet1.Cells(j, 2)
Sheet1.Cells(i, 3) = Sheet1.Cells(j, 3)
Sheet1.Cells(i, 4) = Sheet1.Cells(j, 4)
Sheet1.Cells(i, 5) = Sheet1.Cells(j, 5)
Sheet1.Cells(i, 6) = Sheet1.Cells(j, 6)
Sheet1.Cells(i, 7) = Sheet1.Cells(j, 7)
Sheet1.Cells(i, 8) = Sheet1.Cells(j, 8)
Sheet1.Cells(i, 9) = Sheet1.Cells(j, 9)
Sheet1.Cells(i, 10) = Sheet1.Cells(j, 10)
'-------------------------------------------------------
Sheet1.Cells(j, 1) = 0
Sheet1.Cells(j, 2) = 0
Sheet1.Cells(j, 3) = 0
Sheet1.Cells(j, 4) = 0
Sheet1.Cells(j, 5) = 0
Sheet1.Cells(j, 6) = 0
Sheet1.Cells(j, 7) = 0
Sheet1.Cells(j, 8) = 0
Sheet1.Cells(j, 9) = 0
Sheet1.Cells(j, 10) = 0
Exit For
End If
Next j
End If
Next i

...и гробовая тишина, а как насчет "немного эстетики и гибкости"? :-)