Внесение второго значения в элемент словаря

[andreysuperman42]

Добрый вечер.
На основании одной таблицы создаю другую таблицу с уникальными значениями. Количество фруктов с одинаковыми значениями суммируется.
Как можно вычислить среднее значение цены фруктов с одинаковыми значениями?

[Aleksandr H.]

Option Explicit
Dim dictObject As New Dictionary ' Создаем словарь
Dim varArray, varArray2, Keys
Dim dblКоличество#, dblPrice#
Dim lngRow&, key$
Private Sub CommandButton2_Click()
    Dim val() As String
    '  Application.ScreenUpdating = False    ' Отключаем обновление экрана...
    Range("J2:X65000").ClearContents    '=> Очищаем содержимое на листе
    varArray = Range("A1").CurrentRegion.Value ' Создаем массив varArray
    With dictObject
        .RemoveAll
        For lngRow = 2 To UBound(varArray)
            key = varArray(lngRow, 1) & "|" & varArray(lngRow, 2) & "|" & varArray(lngRow, 3) & "|" & varArray(lngRow, 4)
            dblКоличество = varArray(lngRow, 5)
            dblPrice = varArray(lngRow, 6)                       '=> Цена (как внести в словарь)??????????????????
            If dblКоличество > 0 Then
                If .Exists(key) Then                                         ' Если значение ключа повторяется, тогда...
                '.Item(key) = .Item(key) + dblКоличество ' Суммируем элемент (количество фруктов)
                val = Split(.Item(key), "|")
                val(0) = CInt(val(0)) + 1
                val(1) = CDbl(val(1)) + dblКоличество
                val(2) = Round((CDbl(val(2)) + dblPrice / dblКоличество) / 2, 2)
                .Item(key) = Join(val, "|")
                
                Else                                                                 ' Иначе
                    '.Item(key) = dblКоличество                      ' Вносим количество фруктов в элемент
                    .Item(key) = "1|" & dblКоличество & "|" & dblPrice / dblКоличество
                End If
            End If
        Next lngRow
        
        Keys = .Keys ' Передаем переменной Keys все созданные ключи
        ReDim varArray2(0 To 6, 0 To UBound(Keys)) ' Создаем массив varArray2
        
        For lngRow = 0 To UBound(Keys)
            key = .Keys(lngRow)
            varArray = Split(key, "|")
            varArray2(0, lngRow) = lngRow + 1
            varArray2(1, lngRow) = varArray(1)
            varArray2(2, lngRow) = varArray(2)
            varArray2(3, lngRow) = varArray(3)
            varArray2(4, lngRow) = varArray(0)
            'varArray2(5, lngRow) = Format(.Item(key), "0.00")
            val = Split(.Item(key), "|")
            varArray2(5, lngRow) = CInt(val(1))
            varArray2(6, lngRow) = CDbl(val(2))
            
        Next lngRow
        'Range("J2").Resize(.Count, 6) = Application.Transpose(varArray2) ' Вставка созданного массива varArray2 с транспонированием
        Range("R2").Resize(.Count, 7) = Application.Transpose(varArray2) ' Вставка созданного массива varArray2 с транспонированием
    End With
    'Range("J1") = lngRow
    Range("R1") = lngRow
End Sub

[andreysuperman42]

Спасибо, Александр, за ответ.
К сожалению, среднюю цену не правильно считает и количество округляет до целых чисел.
Но, я думаю, все решаемо. Буду разбираться.

[andreysuperman42]

Разобрался.

Option Explicit
Dim dictObject As New Dictionary ' Создаем словарь
Dim varArray, varArray2, Keys
Dim dblКоличество#, dblPrice#
Dim lngRow&, key$
Private Sub CommandButton2_Click()
    Dim val() As String

    Range("J2:P65000").ClearContents    '=> Очищаем содержимое на листе
    varArray = Range("A1").CurrentRegion.Value ' Создаем массив varArray
    
    With dictObject
        .RemoveAll
        For lngRow = 2 To UBound(varArray)
            key = varArray(lngRow, 1) & "|" & varArray(lngRow, 2) & "|" & varArray(lngRow, 3) & "|" & varArray(lngRow, 4)
            dblКоличество = Format(varArray(lngRow, 5), "0.00")
            dblPrice = varArray(lngRow, 6)                       '=> Цена (разобрался, как внести в словарь)
            If dblКоличество > 0 Then
                If .Exists(key) Then                                         ' Если значение ключа повторяется, тогда...
                    val = Split(.item(key), "|")
                    val(0) = CInt(val(0)) + 1
                    val(1) = Format(CDbl(val(1)) + dblКоличество, "0.00")
                    val(2) = Format(CDbl(val(2)) + dblPrice, "0.00")
                    .item(key) = Join(val, "|")
                Else                                                                 ' Иначе
                    .item(key) = "1|" & dblКоличество & "|" & dblPrice
                End If
            End If
        Next lngRow

        Keys = .Keys ' Передаем переменной Keys все созданные ключи
        ReDim varArray2(0 To 6, 0 To UBound(Keys)) ' Создаем массив varArray2

        For lngRow = 0 To UBound(Keys)
            key = .Keys(lngRow)
            varArray = Split(key, "|")
            varArray2(0, lngRow) = lngRow + 1
            varArray2(1, lngRow) = varArray(1)
            varArray2(2, lngRow) = varArray(2)
            varArray2(3, lngRow) = varArray(3)
            varArray2(4, lngRow) = varArray(0)
            val = Split(.item(key), "|")
            varArray2(5, lngRow) = CDbl(val(1))
            varArray2(6, lngRow) = Format(CDbl(val(2)) / val(0), "0.00")

        Next lngRow
        Range("J2").Resize(.Count, 7) = Application.Transpose(varArray2) ' Вставка созданного массива varArray2 с транспонированием
    End With
    Range("J1") = lngRow
End Sub

[andreysuperman42]

Задача усложнилась.
Теперь надо, чтобы фрукты располагались не вертикально, а горизонтально (в одну строку).
Буду благодарен за помощь.