"свернуть" таблицу

[sn00p]

ок, спасибо комрады за хорошие советы! буду стараться дальше!

[Hugo121]

Кстати, вот в конце http://www.planetaexcel.ru/forum.php?thread_id=5308 параллельный вопрос, как раз этот код использовал для выбора уникальных в массив. Там нет суммирования, но из этих двух кодов можно собрать что угодно - переменная cnt в Item указывает на элемент массива с уникальным значением.

[doober]

Так сделать мой вариант под строку.или нет необходимости в этом

[sn00p]

вот за сегодня накатал собственный код, может кому сгодится .
если таблицу поместить в массив, будет быстрее(над этим буду трудится)
суммирование дублирующих строк и перенос уникальных

Private Sub CommandButton1_Click()

ProgressBar21.Max = 100
ProgressBar21.Min = 0
Dim i As Long, g As Long, ilastrow As Long


ilastrow = Cells(Rows.Count, 1).End(xlUp).Row

'удаление товара в имени которого есть строка "Подарочная карта", т.к. ШК имеет неподходящий форат
For i = ilastrow To 1 Step -1
    namee = Trim(Cells(i, 4))
    If InStr(1, namee, "Подарочная карта") <> 0 Then
        Rows(i).Delete
    End If
DoEvents
ProgressBar21.Value = (i * 100) / ilastrow
Next i

'сортировка листа по 2 колонкам, по номеру документа(А) и по ШК(Е)
ActiveWorkbook.Worksheets("ЛИСТ2").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ЛИСТ2").sort.SortFields.Add Key:=Range("A1:A" + Trim(Str(ilastrow))), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("ЛИСТ2").sort.SortFields.Add Key:=Range("E1:E" + Trim(Str(ilastrow))), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ЛИСТ2").sort
        .SetRange Range("A1:J" + Trim(Str(ilastrow)))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'сложение, построчный перебор
For i = 1 To ilastrow
'переменная которая содержит в себе текущее значение н.док-то и ШК
sKompVal = Trim(Str(Cells(i, 1))) + " " + Trim(Str(Cells(i, 5)))
'переменная кол-ва
iKolPos = Cells(i, 7)
'переменная ном.док-та
nDoc = Trim(Str(Cells(i, 1)))
'переменная ШК
ShKod = Trim(Str(Cells(i, 5)))

clval = WorksheetFunction.SumIfs(Range("G1:G" + Trim(Str(ilastrow))), Range("A1:A" + Trim(Str(ilastrow))), nDoc, Range("E1:E" + Trim(Str(ilastrow))), ShKod)
'что бы не суммировать все подряд строки, а только те что надо(дублирующие) я на дубль проверяю просто - если

'число в переменной iKolPos (текущее кол-во) = вычисленному clval , то это единственная строка и нет смысла далее
 'шерстить список, а если iKolPos не = вычисленному clval, то значит есть еще одна такая  же запись. кстати, для
 'ускорения делается сортировка ОБЯЗАТЕЛЬНО, (код допишу, вставлю exit из цикла , если следующее значение != 
'предыдущему)
    If iKolPos <> clval Then
        For g = i + 1 To ilastrow
            sKompVal2 = Trim(Str(Cells(g, 1))) + " " + Trim(Str(Cells(g, 5)))
            If (sKompVal = sKompVal2) Then 'i > 1 And
                
                i = i + 1
                iKolPos = iKolPos + Cells(g, 7)
            End If
            DoEvents
            ProgressBar21.Value = (i * 100) / ilastrow
        Next g
    End If
Cells(i, 12) = Cells(i, 1)
Cells(i, 13) = Cells(i, 2)
Cells(i, 14) = Cells(i, 3)
Cells(i, 15) = Cells(i, 4)
Cells(i, 16) = Cells(i, 5)
Cells(i, 17) = Cells(i, 6)
Cells(i, 18) = iKolPos
Cells(i, 19) = Cells(i, 8)
Cells(i, 20) = Cells(i, 9)
DoEvents
ProgressBar21.Value = (i * 100) / ilastrow
Next i

MsgBox ("work is complit")
End Sub

собственно вот, смотрите, ругайте))
но работает правильно...
да, еще в последствии работы программы образуются пустые строки, их бы надо удалить

Private Sub CommandButton1_Click()
ilastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = ilastrow To 1 Step -1
    namee = Trim(Cells(i, 1))
    If namee = "" Then Rows(i).Delete

Next i
End Sub