Добрый вечер.
Помогите пожалуйста со словарём.
Как внести данные в Items (Dict4), которые находятся в смещённых ячейках, относительно Keys (Dict1).
Помогите пожалуйста со словарём.
Как внести данные в Items (Dict4), которые находятся в смещённых ячейках, относительно Keys (Dict1).
Код |
---|
Sub Сложить() 'начало процедуры 'объявление переменных Dim M() 'массив. для ускорения обработки Dim Dict1 As Object 'словарь. для облегчения поиска уникальных Dim Dict2 As Object 'словарь. для облегчения поиска уникальных Dim Dict3 As Object 'словарь. для облегчения поиска уникальных Dim Dict4 As Object 'словарь. для облегчения поиска уникальных Dim LR 'последняя занятая строка Лист1.Select 'перейти на лист LR = Лист1.Cells(Rows.Count, 3).End(xlUp).Row 'узнать количество строк M = Лист1.Range(Cells(33, 1), Cells(LR, 11)).Value 'загнать таблицу в массив Set Dict1 = CreateObject("Scripting.Dictionary") 'объявить словарь1 Set Dict2 = CreateObject("Scripting.Dictionary") 'объявить словарь2 Set Dict3 = CreateObject("Scripting.Dictionary") 'объявить словарь3 Set Dict4 = CreateObject("Scripting.Dictionary") 'объявить словарь4 For i = 1 To UBound(M) 'по всему массиву If Dict1.Exists(M(i, 3)) Then 'если в словаре уже имеется Шифр расценки и код Dict1.Item(M(i, 3)) = Dict1.Item(M(i, 3)) + M(i, 6) 'суммировать объём Else 'иначе Dict1.Add M(i, 3), M(i, 6) 'добавить Шифр расценки и код в первый словарь Dict2.Add M(i, 3), M(i, 5) 'добавить Ед. изм. во второй словарь Dict3.Add M(i, 3), M(i, 4) 'добавить Наименование работ и затрат в третий словарь словарь ' Dict4.Add M(i, 3), M(i, 11) 'добавить ВСЕГО затрат в четвёртый словарь ' Вместо M(i, 11) должна быть сумма из (x, 11)! в строке "Всего по позиции:" End If 'выход из условия Next i 'следующая строка ' MsgBox Dict1.Items()(0) ' просмотреть первый items Лист2.Select 'перейти на лист 2 Лист2.Cells.ClearContents 'очистить лист Лист2.Range("A1").Resize(Dict1.Count) = Application.Transpose(Dict1.Keys) 'выгрузить Шифр расценки и код Лист2.Range("B1").Resize(Dict1.Count) = Application.Transpose(Dict2.Items) 'выгрузить Ед. изм. Лист2.Range("C1").Resize(Dict1.Count) = Application.Transpose(Dict3.Items) 'выгрузить Наименование работ и затрат Лист2.Range("D1").Resize(Dict1.Count) = Application.Transpose(Dict1.Items) 'выгрузить сумму объёмов работ 'Лист2.Range("E1").Resize(Dict1.Count) = Application.Transpose(Dict4.Items) 'выгрузить сумму ВСЕГО затрат End Sub 'конец процедуры |