DrUM64 (Автор тем)

Суммирование и удаление дубликатов с сохранением значений в строке

Пользователь

Сообщений: 19 Регистрация: 06.07.2017

17.07.2017 18:50:24

Здравствуйте.
Нашел в архиве вот такой макрос:

Код

Sub Storm_ZCooler() 'http://www.planetaexcel.ru/forum.php?thread_id=45363
Dim Uniq As New Collection, Lastrow As Long, i As Long, j As Long, Arr(), Arr2()
Lastrow = Cells(Rows.Count, 5).End(xlUp).Row
Range(Cells(2, 5), Cells(Lastrow + 1, 6)).Clear
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Arr = Range(Cells(2, 1), Cells(Lastrow, 2)).Value
    For i = 1 To UBound(Arr, 1)
        On Error Resume Next
        Uniq.Add Arr(i, 1), CStr(Arr(i, 1))
    Next
    ReDim Arr2(1 To Uniq.Count, 1 To 2)
    For i = 1 To Uniq.Count
        For j = 1 To UBound(Arr, 1)
            If Arr(j, 1) = Uniq(i) Then
                Arr2(i, 1) = Uniq(i)
                Arr2(i, 2) = Arr2(i, 2) + Arr(j, 2)
            End If
        Next
    Next
    Range(Cells(2, 5), Cells(Uniq.Count + 1, 6)) = Arr2
End Sub

Хочу приспособить его под свою таблицу (во вложении), но что-то не осилить мне.
Задача такая: есть одинаковые товары (столбец В) с разных складов. Надо просуммировать их количество (столбец N), удалив дубликаты и не затрагивая остальные значения, относящиеся к этому товару.
Надо чтобы все операции производились в самой таблице, а не создавались столбцы по соседству. И не должно оставаться пустых строк после удаления дубликата.
Количество строк не известно, и оно у меня определяется так:

Код
n = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

Это должен быть именно макрос, поскольку я его буду вставлять в уже сделанный основной макрос по сортировке таблицы.

Перейти

Переименование: всем одинаковым словам присваивать одинаковое число

DrUM64

Пользователь

Сообщений: 19 Регистрация: 06.07.2017

06.07.2017 01:36:09

Здравствуйте.
Нашел в архиве форума похожую тему.
Но мне нужно сделать иначе. Чтобы всем одинаковым словам (например, именам) присваивалась одна и та же цифра.
К примеру, все Иваны заменялись бы на 100, все Марии на 101 и т. д. до конца столбца. Имена идут вразнобой. Кроме того, совершенно неизвестно, что это будут за имена. Да и не обязательно имена. Артикулы товаров, названия товаров - не имеет значения. И последовательность может быть любая.
Для примера - коротенькая таблица. Очень привлекает идея использовать словарь.
Ну никак не разберусь, что нужно в том макросе из темы по ссылке поменять....
Вот он, чтобы по ссылкам не бегать:

Код

Sub tt()   
Dim LastRow As Long, i As Long   
LastRow = Cells(Rows.Count, 1).End(xlUp).Row   
With CreateObject("scripting.dictionary")   
   For i = 2 To LastRow   
   .Item(Cells(i, 1).Value) = .Item(Cells(i, 1).Value) + 1   
   Cells(i, 1) = Cells(i, 1) & "-" & .Item(Cells(i, 1).Value)   
   Next   
End With   
End Sub

Перейти