Совпадение по номеру (ключу)

[DJTreeno]

Доброго всем времени суток!!!
Ситуация вот какая, надо чтобы на VBA происходил поиск по ключу, с последующим выбором ячеек в ключевой строке и суммированию их, например:

1 50
2 35
1 75
3 65
2 10

Функция должна проверить какие значения в первом столбце совпадают - две единицы совпали и две двойки совпали, следовательно выдает 1 (50+75) 2 (35+10):

должно получится:
1 125
2 45
3 65

То есть, если совпадений не обнаружено, то выдает единичный результат без суммирования, как показано выше.

Пожалуйста помогите, тяжело что-то идет!!!

Заранее благодарен!

[vikttur]

VBA обязательно?
Есть функция СУММЕСЛИ().

[DJTreeno]

да VBA обязательно, щас попробую через сортировку и макрос записать...

[DJTreeno]

Сортировка не подходит, надо указывать по какому ключу сортировать(((
Надо чтоб сравнивало...

[Hugo121]

http://www.planetaexcel.ru/forum.php?thread_id=26105

[DJTreeno]

Спасибище огромное!!!
Искал искал, но не нашел)))

[Hugo121]

Кстати, слово "ключ" как раз "в тему" - там словарь с keys используется
Но сортировки нет!

[DJTreeno]

Hugo121, чет там тяжеловато как-то. Помогите пожалуйста упростить под мою задачу.
У меня известно в каких столбцах будут ключи и в какие результат бросать, еще щас тока подумал:
яблоки 1 50
груши 2 35
яблоки 1 75
бананы 3 65
груши 2 10

Как с текстовыми быть?
Помогите!

[Hugo121]

Сюда код положу:

Sub UniqSummUniversal()    'вариант без Transpose - для больших объёмов
'Выделить диапазон, где в первом столбце - неуникальные, в последнем - суммы
    Dim a(), b(), oDict As Object, i&, ii&, temp$, x&
    Dim ind&
    'Dim tm: tm = Timer
    a = Selection.Value
    ReDim b(1 To UBound(a, 1), 1 To 3)
    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): b(ii, 3) = 1
                    oDict.Add temp, CStr(ii)
                Else
                    x = oDict.Item(temp)
                    b(x, 2) = b(x, 2) + --a(i, ind)
                    b(x, 3) = b(x, 3) + 1
                End If
            End If
        End If
    Next

    If ii > 0 Then
        With Workbooks.Add.Worksheets(1)
            .Columns(1).NumberFormat = "@"
            .Range("A1:C1").Resize(ii) = b
        End With
    Else
        MsgBox "Выделите корректные данные!", vbCritical
    End If
    
    'Debug.Print Timer - tm
    End Sub

Так где у Вас данные, говорите?
В общем, вместо Selection задайте свой известный Вам диапазон.

[slan]

чуть короче:

Sub t()
Dim ar, i&, r(), s$, dic
ar = [dat]
ReDim r(1 To UBound(ar), 1 To 2)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(ar)
    s = CStr(ar(i, 1))
    If dic.exists(s) Then
        r(dic(s), 2) = r(dic(s), 2) + ar(i, 2)
    Else
        dic.Add s, dic.Count + 1
        r(dic.Count, 1) = ar(i, 1)
        r(dic.Count, 2) = ar(i, 2)
    End If
Next
[d1].Resize(dic.Count, 2) = r
End Sub