Доброго времени суток всем. Своими силами так и не смог разобраться. Необходимо объединить и суммировать ячейки. Использую такой макрос: [vba]
Код
Sub Объеденить() Dim lngI As Long, lngJ As Long Dim bytR As Byte For lngI = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1 For lngJ = lngI - 1 To 2 Step -1 If Cells(lngI, 1) = Cells(lngJ, 1) Then For bytR = 2 To 10 Cells(lngJ, bytR) = Cells(lngJ, bytR) + Cells(lngI, bytR) Next bytR Rows(lngI).Delete shift:=xlUp End If Next lngJ Next lngI End Sub
[/vba] в моём случае он объединяет по первому столбцу, соответственно колонка "товар" тоже суммируется, не могу понять что необходимо поменять в коде, чтобы уникальные значения искались по второму столбцу и "артикул" тоже не суммировался. пример прилагается Заранее благодарен за ответы.
Доброго времени суток всем. Своими силами так и не смог разобраться. Необходимо объединить и суммировать ячейки. Использую такой макрос: [vba]
Код
Sub Объеденить() Dim lngI As Long, lngJ As Long Dim bytR As Byte For lngI = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1 For lngJ = lngI - 1 To 2 Step -1 If Cells(lngI, 1) = Cells(lngJ, 1) Then For bytR = 2 To 10 Cells(lngJ, bytR) = Cells(lngJ, bytR) + Cells(lngI, bytR) Next bytR Rows(lngI).Delete shift:=xlUp End If Next lngJ Next lngI End Sub
[/vba] в моём случае он объединяет по первому столбцу, соответственно колонка "товар" тоже суммируется, не могу понять что необходимо поменять в коде, чтобы уникальные значения искались по второму столбцу и "артикул" тоже не суммировался. пример прилагается Заранее благодарен за ответы.taimens
Sub Объединить() Dim lngI As Long, lngJ As Long Dim bytR As Byte For lngI = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1 For lngJ = lngI - 1 To 2 Step -1 If Cells(lngI, 2) = Cells(lngJ, 2) Then For bytR = 3 To 10 Cells(lngJ, bytR) = Cells(lngJ, bytR) + Cells(lngI, bytR) Next bytR Rows(lngI).Delete shift:=xlUp End If Next lngJ Next lngI End Sub
[/vba]
Здравствуйте. Попробуйте так [vba]
Код
Sub Объединить() Dim lngI As Long, lngJ As Long Dim bytR As Byte For lngI = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1 For lngJ = lngI - 1 To 2 Step -1 If Cells(lngI, 2) = Cells(lngJ, 2) Then For bytR = 3 To 10 Cells(lngJ, bytR) = Cells(lngJ, bytR) + Cells(lngI, bytR) Next bytR Rows(lngI).Delete shift:=xlUp End If Next lngJ Next lngI End Sub