Excel VBA: Scripting.Dictionary Расчеты

У меня есть следующие значения в электронной таблице:

Printer Name | Pages | Copies
HP2300       | 2     | 1
HP2300       | 5     | 1
Laser1       | 2     | 2
Laser1       | 3     | 4
HP2300       | 1     | 1

Как я могу получить общее количество напечатанных страниц (страниц * копий) на каждом принтере следующим образом:

Printer Name | TotalPages |
HP2300       | 8          |
Laser1       | 16         |

Мне удалось создать список, подсчитывающий, сколько раз принтер использовался для печати:

Sub UniquePrints()

Application.ScreenUpdating = False
Dim Dict As Object
Set Dict = CreateObject("scripting.dictionary")
Dim varray As Variant, element As Variant

varray = Sheets("Prints").Range("E:E").Value
For Each element In varray
    If Dict.exists(element) Then
        Dict.Item(element) = Dict.Item(element) + 1
    Else
        Dict.Add element, 1
    End If
Next

Sheets("Stats").Range("D6").Resize(Dict.Count, 1).Value = _
    WorksheetFunction.Transpose(Dict.keys)
Sheets("Stats").Range("E6").Resize(Dict.Count, 1).Value = _
    WorksheetFunction.Transpose(Dict.items)

Application.ScreenUpdating = True
End Sub

Как подсчитать общее количество страниц для каждой печати (строки) (страниц * копий) и сохранить их в словаре вместо простого добавления 1?

Спасибо за помощь

2 ответа

Решение

Прочитайте в столбцах E:G, а не просто E, и используйте второе измерение этого массива, чтобы добавить копии страниц * вместо добавления 1.

Sub UniquePrints()

    Dim Dict As Object
    Dim vaPrinters As Variant
    Dim i As Long

    Set Dict = CreateObject("scripting.dictionary")

    vaPrinters = Sheets("Prints").Range("E2:G6").Value

    For i = LBound(vaPrinters, 1) To UBound(vaPrinters, 1)
        If Dict.exists(vaPrinters(i, 1)) Then
            Dict.Item(vaPrinters(i, 1)) = Dict.Item(vaPrinters(i, 1)) + (vaPrinters(i, 2) * vaPrinters(i, 3))
        Else
            Dict.Add vaPrinters(i, 1), vaPrinters(i, 2) * vaPrinters(i, 3)
        End If
    Next i

    Sheets("Stats").Range("D6").Resize(Dict.Count, 1).Value = _
        WorksheetFunction.Transpose(Dict.keys)
    Sheets("Stats").Range("E6").Resize(Dict.Count, 1).Value = _
        WorksheetFunction.Transpose(Dict.items)

End Sub

Для заполнения ячеек можно использовать формулу массива:

={SUMPRODUCT(IF($A$2:$A$6=$F2;1;0);$B$2:$B$6;$C$2:$C$6)}

Формула вставляется из окна формулы с помощью Ctrl-Shift-Enter. Скрученные скобки вставляются в Excel, а не пользователем. Формула может быть скопирована в другом месте.

введите описание изображения здесь

Другие вопросы по тегам