Добрый день господа. Решил тут посмотреть что это за словари и уперся банально не знаю как в словаре держать 3-5 параметров к ключу Может не по русски выражаюсь... [vba]
Код
' out2 некий массив с данными
Set td = CreateObject("Scripting.Dictionary") 'Надо проверить уникальность дат Set tout = CreateObject("Scripting.Dictionary") ' Основной словарь
summ = 0
For i = LBound(out2) To UBound(out2)
If tout.Exists(out2(i, 4)) Then t = tout.Item(out2(i, 4)) 'извлекаем текущее значение t = CDbl(t) + CDbl(Replace(out2(i, 2), ".", ",")) ' Суммируем по уникальному признаку (тут числовые значения) tout.Item(out2(i, 4)) = t 'заносим новое значение summ = summ + CDbl(Replace(out2(i, 2), ".", ",")) ' Общая сумма
Else tout.Item(out2(i, 4)) = 0 ' Добавляем в ловарь tout(out2(i, 4)) = CDbl(Replace(out2(i, 2), ".", ",")) ' Берем первую сумму по уникальному признаку summ = summ + CDbl(Replace(out2(i, 2), ".", ",")) ' Везде проводим сумму всех чисел End If
td.Item(CDate(out2(i, 3))) = CDate(out2(i, 3)) ' Тут тупо проверяем есть ли разные даты
Next i
If td.Count = 1 Then tds = td.Items()(UBound(td.Keys)) ' Если дата одна то запоминаем ее в tds
Else
tds = td.Items()(0) ' Если дат несколько то берем первую дату и потом к нему пишем остальные даты
For i = LBound(td.Keys) To UBound(td.Keys) - 1 tds = tds & ";" & Chr(10) & td.Items()(i + 1)
Next i
End If
[/vba]
Так вот у меня получается по уникальному ключу держать и суммировать все вхождения... Макрос работает. Но не могу дойти как к нему приделать что бы он еще вел счетчик к каждому вхождению (сколько раз про суммировалось) по каждому ключу... Помогите. Дайте пинка в нужном направлении. Уже пол инета об лазал...
И можно ли сортировать словарь? В некоторых источниках пишут что можно использовать функции листа. Но кроме фильтра больше никакой инфы.
Добрый день господа. Решил тут посмотреть что это за словари и уперся банально не знаю как в словаре держать 3-5 параметров к ключу Может не по русски выражаюсь... [vba]
Код
' out2 некий массив с данными
Set td = CreateObject("Scripting.Dictionary") 'Надо проверить уникальность дат Set tout = CreateObject("Scripting.Dictionary") ' Основной словарь
summ = 0
For i = LBound(out2) To UBound(out2)
If tout.Exists(out2(i, 4)) Then t = tout.Item(out2(i, 4)) 'извлекаем текущее значение t = CDbl(t) + CDbl(Replace(out2(i, 2), ".", ",")) ' Суммируем по уникальному признаку (тут числовые значения) tout.Item(out2(i, 4)) = t 'заносим новое значение summ = summ + CDbl(Replace(out2(i, 2), ".", ",")) ' Общая сумма
Else tout.Item(out2(i, 4)) = 0 ' Добавляем в ловарь tout(out2(i, 4)) = CDbl(Replace(out2(i, 2), ".", ",")) ' Берем первую сумму по уникальному признаку summ = summ + CDbl(Replace(out2(i, 2), ".", ",")) ' Везде проводим сумму всех чисел End If
td.Item(CDate(out2(i, 3))) = CDate(out2(i, 3)) ' Тут тупо проверяем есть ли разные даты
Next i
If td.Count = 1 Then tds = td.Items()(UBound(td.Keys)) ' Если дата одна то запоминаем ее в tds
Else
tds = td.Items()(0) ' Если дат несколько то берем первую дату и потом к нему пишем остальные даты
For i = LBound(td.Keys) To UBound(td.Keys) - 1 tds = tds & ";" & Chr(10) & td.Items()(i + 1)
Next i
End If
[/vba]
Так вот у меня получается по уникальному ключу держать и суммировать все вхождения... Макрос работает. Но не могу дойти как к нему приделать что бы он еще вел счетчик к каждому вхождению (сколько раз про суммировалось) по каждому ключу... Помогите. Дайте пинка в нужном направлении. Уже пол инета об лазал...
И можно ли сортировать словарь? В некоторых источниках пишут что можно использовать функции листа. Но кроме фильтра больше никакой инфы.Timber_Wolf
Сообщение отредактировал Timber_Wolf - Вторник, 14.02.2017, 16:25
.... Else tout.Item(out2(i, 4)) = 0 ' Добавляем в ловарь' скорее всего лишнее tout(out2(i, 4)) = CDbl(Replace(out2(i, 2), ".", ",")) ' наверное, наоборот запятую нужно менять на точку summ = summ + CDbl(Replace(out2(i, 2), ".", ",")) ' Везде проводим сумму всех чисел cnt=cnt+1'счетчик End If
[/vba]
может так: [vba]
Код
.... Else tout.Item(out2(i, 4)) = 0 ' Добавляем в ловарь' скорее всего лишнее tout(out2(i, 4)) = CDbl(Replace(out2(i, 2), ".", ",")) ' наверное, наоборот запятую нужно менять на точку summ = summ + CDbl(Replace(out2(i, 2), ".", ",")) ' Везде проводим сумму всех чисел cnt=cnt+1'счетчик End If
https://msdn.microsoft.com/en-us/library/x4k5wbx4%28v=vs.84%29 Один ключ - одно значение. Вариант или Join/slit использовать при формировании значения, ну и соотвтевенно текстом сумма, разделитель, счетчик там хранить , или делать доп словарь с одинаковым набором ключей, и уже там хранить счетчик
И еще вопрос, нужен именно скрипт? Задача элементарная для сводной таблицы.
https://msdn.microsoft.com/en-us/library/x4k5wbx4%28v=vs.84%29 Один ключ - одно значение. Вариант или Join/slit использовать при формировании значения, ну и соотвтевенно текстом сумма, разделитель, счетчик там хранить , или делать доп словарь с одинаковым набором ключей, и уже там хранить счетчик
И еще вопрос, нужен именно скрипт? Задача элементарная для сводной таблицы.bmv98rus
Sub d() Dim pr(1 To 2), d As Object, a Set d = CreateObject("Scripting.Dictionary") pr(1) = "A": pr(2) = 10: d(1) = pr a = d(1) pr(1) = a(1) & "B": pr(2) = a(2) + 30: d(1) = pr a = d(1) End Sub
Sub d() Dim pr(1 To 2), d As Object, a Set d = CreateObject("Scripting.Dictionary") pr(1) = "A": pr(2) = 10: d(1) = pr a = d(1) pr(1) = a(1) & "B": pr(2) = a(2) + 30: d(1) = pr a = d(1) End Sub
Даже не пытаюсь возразить, Item - конечно не значение, а элемент. Dот про то что туда массив можно впихнуть, забыл напрочь, или не знал :-)
SLAVIK. а с практической точки зрения, что эффективнее и проще, в Item держать объект или иметь отдельно массив двумерный (несколько одномерных), а в словаре хранить индекс по одному измерению. То есть словарь используем для хранения поиска индекса по значению, а массив для хранения данных связанных с этим значением? Естесвенно , при заполнении , изменение размера массивов доп. операция, если не знать заблаговременно.
Даже не пытаюсь возразить, Item - конечно не значение, а элемент. Dот про то что туда массив можно впихнуть, забыл напрочь, или не знал :-)
SLAVIK. а с практической точки зрения, что эффективнее и проще, в Item держать объект или иметь отдельно массив двумерный (несколько одномерных), а в словаре хранить индекс по одному измерению. То есть словарь используем для хранения поиска индекса по значению, а массив для хранения данных связанных с этим значением? Естесвенно , при заполнении , изменение размера массивов доп. операция, если не знать заблаговременно.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Сообщение отредактировал bmv98rus - Среда, 15.02.2017, 07:56
SLAVICK, По вашему примеру тоже дома получилось =))
bmv98rus, С вашим примером решил не пробовать, т.к. массивы роднее =)))
Красота =)) Всем спасибо =))) И +1 в карму =)))
А все таки словари можно обрабатывать функциями листа? =)) Кроме Filter? =)) Короче интересует сортировка, т.к. уникальные в реальном примере не идут по возрастанию =)))
nilem, О =)) Спасибо =)) Вариант рабочий =)))
SLAVICK, По вашему примеру тоже дома получилось =))
bmv98rus, С вашим примером решил не пробовать, т.к. массивы роднее =)))
Красота =)) Всем спасибо =))) И +1 в карму =)))
А все таки словари можно обрабатывать функциями листа? =)) Кроме Filter? =)) Короче интересует сортировка, т.к. уникальные в реальном примере не идут по возрастанию =)))Timber_Wolf
Нет, сам словарь не умеет сортировать. Выгружаем массив на лист и сортируем на листе - обычно так делают. Можно посмотреть NoDups от ZVI - коллекция с сортировкой.
Нет, сам словарь не умеет сортировать. Выгружаем массив на лист и сортируем на листе - обычно так делают. Можно посмотреть NoDups от ZVI - коллекция с сортировкой.nilem
В зависимости от задачи. Массив отдельно имеет смысл использовать если знаете каких размерностей его создавать. Если нет - то я использую словарь с массивами или словарь со словарями в айтемах(коллекции как-то не люблю) Потом при помощи команды [vba]
Исправил сообщение Можно массивы сортировать при помощи ЮДФ-ки например тут есть пара штук да и тут на форуме я несколько раз выкладывал например тут в примере файла. Про сортировку словарей почитайте тут
И поскольку это уже совсем другая тема - если хотите ее развивать создавайте новую тему.
В зависимости от задачи. Массив отдельно имеет смысл использовать если знаете каких размерностей его создавать. Если нет - то я использую словарь с массивами или словарь со словарями в айтемах(коллекции как-то не люблю) Потом при помощи команды [vba]
Исправил сообщение Можно массивы сортировать при помощи ЮДФ-ки например тут есть пара штук да и тут на форуме я несколько раз выкладывал например тут в примере файла. Про сортировку словарей почитайте тут
И поскольку это уже совсем другая тема - если хотите ее развивать создавайте новую тему.SLAVICK
- если исходные данные на листе , то берём их в массив, и его же и используем для сводной, а в словаре храним индексы/адресацию данных в этом массиве. И его же выгружаем в финале - но не весь, а только заполненную верхушку. Таких примеров на форумах десятки было, я наверное один из них написал А сортировать можно ключи в массиве. Или вот например: [vba]
Код
Set Result = CreateObject("System.Collections.ArrayList") Result.AddRange Dict.Keys Result.Sort Unique = Application.WorksheetFunction.Transpose(Result.ToArray)
[/vba] Это нужен .Net, но оно обычно у всех есть.
P.S. Т.к. там столбцы меняют расположение - проще создать для результата спецмассив: [vba]
Код
Sub tt() Dim a, i&, x&, t&
a = [a1].CurrentRegion.Value ReDim b(1 To UBound(a) + 1, 1 To 3) b(1, 1) = "Уник" b(1, 2) = "Кол-во": b(2, 2) = UBound(a) - 1 b(1, 3) = "Сумма" x = 2
With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 2 To UBound(a) b(2, 3) = b(2, 3) + a(i, 2) If Not .exists(a(i, 4)) Then x = x + 1: .Item(a(i, 4)) = x b(x, 1) = a(i, 4) b(x, 2) = b(x, 2) + 1 b(x, 3) = a(i, 2) Else t = .Item(a(i, 4)) b(t, 2) = b(t, 2) + 1 b(t, 3) = b(t, 3) + a(i, 2) End If Next End With
- если исходные данные на листе , то берём их в массив, и его же и используем для сводной, а в словаре храним индексы/адресацию данных в этом массиве. И его же выгружаем в финале - но не весь, а только заполненную верхушку. Таких примеров на форумах десятки было, я наверное один из них написал А сортировать можно ключи в массиве. Или вот например: [vba]
Код
Set Result = CreateObject("System.Collections.ArrayList") Result.AddRange Dict.Keys Result.Sort Unique = Application.WorksheetFunction.Transpose(Result.ToArray)
[/vba] Это нужен .Net, но оно обычно у всех есть.
P.S. Т.к. там столбцы меняют расположение - проще создать для результата спецмассив: [vba]
Код
Sub tt() Dim a, i&, x&, t&
a = [a1].CurrentRegion.Value ReDim b(1 To UBound(a) + 1, 1 To 3) b(1, 1) = "Уник" b(1, 2) = "Кол-во": b(2, 2) = UBound(a) - 1 b(1, 3) = "Сумма" x = 2
With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 2 To UBound(a) b(2, 3) = b(2, 3) + a(i, 2) If Not .exists(a(i, 4)) Then x = x + 1: .Item(a(i, 4)) = x b(x, 1) = a(i, 4) b(x, 2) = b(x, 2) + 1 b(x, 3) = a(i, 2) Else t = .Item(a(i, 4)) b(t, 2) = b(t, 2) + 1 b(t, 3) = b(t, 3) + a(i, 2) End If Next End With
Не лень Вам с этими словарями возится :), Запросами такие задачи решаются в 5 минут и 10 строчек! [vba]
Код
Public Sub RefreshData() 'Created using add-in ActiveTables Dim strConnection As String Dim strSQL As String strConnection = IIf(Val(Application.Version) < 12, "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';", "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';") strSQL = "SELECT 0 as [Уникальный код], count(*) as Количество, SUM(Сумма) as Сумма FROM [Лист1$] Where Сумма<>0 union all SELECT [Уникальный код], count(*) as Количество, SUM(Сумма) as Сумма FROM [Лист1$] Where Сумма<>0 GROUP BY [Уникальный код] ORDER BY [Уникальный код] " With ThisWorkbook.ActiveSheet With .QueryTables.Add(strConnection, .Range("i17"), strSQL) .Refresh False .Delete End With End With End Sub
[/vba]
Не лень Вам с этими словарями возится :), Запросами такие задачи решаются в 5 минут и 10 строчек! [vba]
Код
Public Sub RefreshData() 'Created using add-in ActiveTables Dim strConnection As String Dim strSQL As String strConnection = IIf(Val(Application.Version) < 12, "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';", "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';") strSQL = "SELECT 0 as [Уникальный код], count(*) as Количество, SUM(Сумма) as Сумма FROM [Лист1$] Where Сумма<>0 union all SELECT [Уникальный код], count(*) as Количество, SUM(Сумма) as Сумма FROM [Лист1$] Where Сумма<>0 GROUP BY [Уникальный код] ORDER BY [Уникальный код] " With ThisWorkbook.ActiveSheet With .QueryTables.Add(strConnection, .Range("i17"), strSQL) .Refresh False .Delete End With End With End Sub
PowerBoy, Да возможно для вас ваш вариант понятнее =))) К сожалению для меня это темный лес пока =)) И если обработку листа я потом могу прикрутить к массиву, то вашу нет =))
PowerBoy, Да возможно для вас ваш вариант понятнее =))) К сожалению для меня это темный лес пока =)) И если обработку листа я потом могу прикрутить к массиву, то вашу нет =))Timber_Wolf
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
