суммирования а затем удаления дубликатов

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » суммирования а затем удаления дубликатов (Макросы/Sub)

taimens

Дата: Пятница, 12.05.2017, 00:47 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Доброго времени суток всем. Своими силами так и не смог разобраться. Необходимо объединить и суммировать ячейки. Использую такой макрос:
[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]
в моём случае он объединяет по первому столбцу, соответственно колонка "товар" тоже суммируется, не могу понять что необходимо поменять в коде, чтобы уникальные значения искались по второму столбцу и "артикул" тоже не суммировался. пример прилагается
Заранее благодарен за ответы.

К сообщению приложен файл: -1-.xlsx (11.1 Kb)

Сообщение отредактировал taimens - Пятница, 12.05.2017, 00:49

Ответить

Pelena

Дата: Пятница, 12.05.2017, 08:49 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19174

Репутация: 4413 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Попробуйте так
[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

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

taimens

Дата: Пятница, 12.05.2017, 09:04 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Pelena, спасибо большое, так пробовал, пропустил одну "2"

. Ещё раз спасибо.

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » суммирования а затем удаления дубликатов (Макросы/Sub)

Страница 1 из 1
1