Доброго времени суток тем, с кем еще сегодня не приветствовали друг друга.
Будьте добры, помогите осуществить в словаре сортировку полученных ключей по алфавиту. Спасибо!
Будьте добры, помогите осуществить в словаре сортировку полученных ключей по алфавиту. Спасибо!
Код |
---|
Sub ВидыТопливаЛитрыСредняяЦена() Sheets("ГПН").Select '===============Создаем словарь=========== Dim dic Set dic = CreateObject("Scripting.Dictionary") 'создаем словарь dic.CompareMode = TextCompare ' текстовый режим - игнорирует регистр For i = 2 To Cells(Rows.Count, 3).End(xlUp).row 'цикл с ДВАДЦАТОЙ строки листа до последней заполненной k = Range("D" & i) 'создаем ключ для словаря сцепкой ячеек. Все ключи в словаре уникальны it = Range("E" & i) 'значение по ключу, в примере - количество If dic.Exists(k) Then 'проверяем, есть ли уже такой ключ в словаре dic.item(k) = dic.item(k) + it 'если есть, суммируем колличество с тем, что уже было ранее Else dic.Add k, it 'если нет, делаем в словаре новую запись End If Next Rows("1:" & dic.Count + 7).Insert 'вставляем сверху строки СтрокаВыгрузки = 1 'строка формирования заголовка и первая строка для выгрузки данных [a1] = "Вид топлива": [b1] = "Кол-во л.": 'в пятой строке делаем шапку i = СтрокаВыгрузки + 1 'с этой строки будем выгружать данные из словаря For Each ky In dic.keys 'цикл переборки всех записанных ключей ar = ky 'разделяем сцепку обратно, получаем два элемента Range("A" & i) = ar 'записываем эти элементы в ячейки Range("B" & i) = dic.item(ky) 'записываем в ячейку количество i = i + 1 'переходим к следующей строке k = 1 k = k + 1 Range("A" & i & ",A" & i - 1).MergeCells = True Next dic.RemoveAll End Sub |
Улыбнись.