Убрать дубликаты и подсчёт суммы по каждому уникальному значению.

[Miguel Sanchez]

Hugo121!
Вот спасибо! Лепота! - Все бы это осилить еще...
Буду погружаться на выходных: вижу, все искушенные кодировщики используют искомые объекты, а сам, хоть и стремлюсь достичь вашего уровня, но по сей день никак не долезу - учителей просветленных да терпеливых не было... ну ничего..., не так все безнадежно, думаю.
...на правах офтопика...

[Djeki]

Уважаемые знатоки Экселя, извините что пишу в этой теме а не открываю новую . Возникла новая , но очень похожая задача. В книге три листа. На лист 2 есть список: код (столбец А) и цена ( столбец С). Используя код уважаемого Hugo121, я создал с помощью Словаря, список уникальных значений с суммой цены по каждому уникальному коду. Дальше необходимо номер из листа 3 ( столбец 1), проверить, и если этот номер есть в списке уникальных значений вывести его и сумму по нему на лист 1 . Я это сделал так, во вложенном файле: список уникальных вывел на лист 1, и далее проверяю наличие номера из листа 3 в Словаре и если такой номер есть - через функцию Selection.Find нахожу его и сумму. Но функции Selection.Find , Activate работают медленно и вероятно есть более быстрые способы решения этой задачи. В этом собственно и заключается мой вопрос: "Как это сделать быстрее ?" Спасибо за ответ.

[Hugo121]

Первым делом в глаза резануло CDbl:
oDict.Add temp, CDbl(ii)
У меня было Cstr(ii)
Зачем вообще Cdbl, если там целые числа?

"проверяю наличие номера из листа 3 в Словаре и если такой номер есть" - так сразу и берите из массива данные по Item словаря.

Вот, в 5 раз быстрее - убрал селекшены и активации, лишние выгрузки и поиск:

Sub Dublic2()    'вариант без Transpose - для больших объёмов
    Dim a(), b(), oDict As Object, i&, ii&, temp$, x&
    Dim ind&, tm&, v
    tm = timeGetTime
    Application.ScreenUpdating = 0
    v = Лист3.UsedRange
    With Лист2
        a = Intersect(.UsedRange, .Columns("A:C")).Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 2)
    ind = UBound(a, 2)    'столб с сумой
    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = 1
    For i = 1 To UBound(a)
        If Not IsEmpty(a(i, ind)) Then
            If IsNumeric(a(i, ind)) Then
                temp = Trim(a(i, 1))
                If Not oDict.Exists(temp) Then
                    ii = ii + 1
                    b(ii, 1) = temp: b(ii, 2) = a(i, ind)
                    oDict.Add temp, CStr(ii)
                Else
                    x = oDict.Item(temp)
                    b(x, 2) = --(b(x, 2)) + (a(i, ind))
                End If
            End If
        End If
    Next
    On Error Resume Next    'если вдруг ii=0
    x = UBound(v)
    ii = 0
    ReDim c(1 To UBound(v, 1), 1 To 2)
    For i = 1 To x
        temp = v(i, 1)
        If oDict.Exists(temp) = True Then
            ii = ii + 1
            x = oDict.Item(temp)
            c(ii, 1) = b(x, 1)
            c(ii, 2) = b(x, 2)
        End If
    Next
    With Лист1
    .Columns("A:B").ClearContents
    .Range("A1:B1").Resize(ii) = c
    .Range("A1").Select
    .Cells(2, 6) = timeGetTime - tm & "  милисек"
    End With
    On Error GoTo 0
End Sub

Ещё чуть подкорректировал - у меня за 29 мсек. отрабатывает.

[Djeki]

Спасибо. Всё очень быстро и здорово. Я пробовал делать
x = oDict.Item(temp)
но выдавало число, и я видимо не разобрался что это за число.
Непонятно почему два минуса в строке
b(x, 2) = --(b(x, 2)) + (a(i, ind))
и не понял почему в
x = oDict.Item(temp)
c(ii, 1) = b(x, 1)
c(ii, 2) = b(x, 2)
найденный х
x = oDict.Item(temp)
означает номер искомого элемента в массиве переменных b() ???
Ещё вопрос: В Коллекции можно искать oDict.Item(temp) и по значению и по ключу ??
Т.е. если в temp ввести ключ - найдёт значение соответствующие этому ключу, а если в temp ввести значение- найдет соответствующий ключ ???
Спасибо за ответ.

[Hugo121]

Два минуса - это бинарный минус, переводим строку в число.
Если убрать этот бинарный минус, то "1" + 1 = "11"
x = oDict.Item(temp)
означает номер искомого элемента в массиве переменных b() - именно так и выходит, потому что в массив b мы и заносим по значению из oDict.Item(temp)
В словаре хранится слово и его Item. Как Item мы кладём значение счётчика, и по этому счётчику заносим значения в параллельный массив, который со словарём никак в общем не связан.
Общее только то, что в словаре имеем слово и Item, который является "адресом" этого слова в массиве - в строке с этим номером мы собираем все данные по этому слову.
Как-то так, надеюсь понятно объяснил

[Hugo121]

И кстати, тут можно ещё на пару миллисекунд убыстрится, если вообще упразднить массив b за ненадобностью - суммы можно прямо в словаре собирать:

Sub Dublic3()    'вариант без Transpose - для больших объёмов
    Dim a(), oDict As Object, i&, ii&, temp$, x&
    Dim ind&, tm&, v
    tm = timeGetTime
    Application.ScreenUpdating = 0
    v = Лист3.UsedRange
    With Лист2
        a = Intersect(.UsedRange, .Columns("A:C")).Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 2)
    ind = UBound(a, 2)    'столб с сумой
    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = 1
    For i = 1 To UBound(a)
        If Not IsEmpty(a(i, ind)) Then
            If IsNumeric(a(i, ind)) Then
                temp = Trim(a(i, 1))
                If Not oDict.Exists(temp) Then
                    ii = ii + 1
                    oDict.Add temp, a(i, ind)
                Else
                    oDict.Item(temp) = --oDict.Item(temp) + (a(i, ind))
                End If
            End If
        End If
    Next
    On Error Resume Next    'если вдруг ii=0
    x = UBound(v)
    ii = 0
    ReDim c(1 To UBound(v, 1), 1 To 2)
    For i = 1 To x
        temp = v(i, 1)
        If oDict.Exists(temp) = True Then
            ii = ii + 1
            x = oDict.Item(temp)
            c(ii, 1) = temp
            c(ii, 2) = oDict.Item(temp)
        End If
    Next
    With Лист1
    .Columns("A:B").ClearContents
    .Range("A1:B1").Resize(ii) = c
    .Range("A1").Select
    .Cells(2, 6) = timeGetTime - tm & "  милисек"
    End With
    On Error GoTo 0
End Sub

[Djeki]

Спасибо за ответ. Предложенный алгоритм работает очень быстро, скорость обработки сопоставима со скоростью обработки встроенными функциями Excel.
Нашёл, на мой взгляд, одну лишнюю строку в коде:

For i = 1 To x
temp = v(i, 1)
If oDict.Exists(temp) = True Then
ii = ii + 1
x = oDict.Item(temp) 'лишняя строка т.к. дублируется двумя 'стоками ниже
c(ii, 1) = temp
c(ii, 2) = oDict.Item(temp)

Кроме того, в переменной Х находилась конечное количество повторений цикла FOR.. А я его изменял по ходу выполнения цикла. Но всё работало несмотря ни на что..

[Hugo121]

Да, эабыл эту строку убрать - это осталось от работы с массивом.
Но с х там действительно неувязка - у меня в первоначальном коде не было For i = 1 To x... Неуследил...

[Djeki]

Это я туда "втулил" переменную Х, мне и отвечать..
А Вам ещё раз спасибо за помошь !!! Чесно говоря не ожидал такой скорости обработки.. Удачи.

[Hugo121]

Нет, это я втулил по образцу сверху - не заметил, что х уже в цикле используется...