Страницы: 1
RSS
Аналог сводной таблицы через массив в VBA
 
Добрый день!
Просьба оказать содействие в таком вопросе, приложил небольшой пример, чтобы проще было объяснить. На листе "изначально" есть таблица с № покупалеля, его ФИО, суммами и датами покупок. Нужно на новый лист получить для каждого уникального № покупателя: 1) его ФИО, просто первое попавшееся значение. допустим что оно может по разному писать и не важно, чтобы было уникальным; 2) сумму всех его заказов; 3) дату самой первой покупки; 4) дату последней покупки.
Итог должен получить например как на листе "результат".
Конечно это можно сделать средствами сводной таблицы через VBA, но предполагается, что входящие данные будут ГОРАЗДО больших объемов и суммируемых полей тоже будет больше, хотелось бы получить пример работы через массив.
Заранее благодарен за все идеи.
 
Словарь массивов. В качестве индекса либо номер клиента, либо ФИО,В качестве значения массив с оставшейся аналитикой.

Добавил код в файл на "скорую руку". CurrentDic - твой итоговый словарь.
Изменено: Grr - 14.04.2015 04:39:07
 
Grr, я в VBA новичок, поэтому не могли бы дать пару разъяснений:
1) не понял где в коде береться первая\последняя дата заказа для каждого уникального № покупателя?
2) всё никак не могу понять, как мне на лист вернуть данные из CurrentDic?
 
alexss, если словарь не содержит индекс, то создается новая запись, где дата первого заказа и дата последнего будут равны. Если запись уже существует, то складываем суммы заказов, и последнюю дату меняем. Кстати, неверно, потребуется проверка, что новая дата больше старой.

Приложил файл с выводом результата
Изменено: Grr - 14.04.2015 07:59:32
 
Думаю быстрее будет работать не на словаре массивов, а на трёх параллельных словарях - по одному ключу в первом собираем суммы, в других храним даты.
Можно первую дату брать не первую попавшуюся, а минимальную, ну и последнюю аналогично. Хотя конечно если они изначально находятся в нужном порядке, то эти проверки не нужны, нечего тратить время.
 
Grr, спасибо огромное за помощь ! ! !
Grr, Hugo, я так понимаю, что в рассматриваемом примере нужно в идеале сортировать данные по дате предварительно, если есть вероятность того, что они могут быть перепутаны? Т.к. для первой даты заказа береться первое попавшееся значение, для последней - соответственно последнее?
 
Т.к. Grr отсутствует, скажу за него - по коду http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=65395&TITLE_SEO=65395-analog-... да.
 
Цитата
Hugo написал: Можно первую дату брать не первую попавшуюся, а минимальную, ну и последнюю аналогично.

А как - \\Можно первую дату брать не первую попавшуюся, а минимальную, ну и последнюю аналогично\\? Можете на этом же примере показать?
Изменено: alexss - 14.04.2015 10:05:02
 
Я пока пас, некогда.
Если не будет вариантов - напомните позже или вечером.
 
alexss, увижу, что тему поднимаете через 30 минут - закрою её.
 
Нужно 4 словаря:
Код
Option Explicit

Sub tt()
    Dim a(), i&, t$, k
    Dim d1 As Object, d2 As Object, d3 As Object, d4 As Object

    Set d1 = CreateObject("Scripting.Dictionary"): d1.comparemode = 1
    Set d2 = CreateObject("Scripting.Dictionary"): d2.comparemode = 1
    Set d3 = CreateObject("Scripting.Dictionary"): d3.comparemode = 1
    Set d4 = CreateObject("Scripting.Dictionary"): d4.comparemode = 1

    With Sheets("изначально")
        a = .[a1].CurrentRegion.Value

        For i = 2 To UBound(a)
            t = a(i, 1)
            If d1.exists(t) Then
                d2.Item(t) = d2.Item(t) + a(i, 3)
                d3.Item(t) = IIf(a(i, 4) < d3.Item(t), a(i, 4), d3.Item(t))
                d4.Item(t) = IIf(a(i, 4) > d4.Item(t), a(i, 4), d4.Item(t))
            Else
                d1.Item(t) = a(i, 2)
                d2.Item(t) = a(i, 3)
                d3.Item(t) = a(i, 4)
                d4.Item(t) = a(i, 4)
            End If
        Next

        ReDim a(1 To d1.Count + 1, 1 To 5): i = 1
        a(i, 1) = "№ клиента"
        a(i, 2) = "ФИО"
        a(i, 3) = "всего сумма заказа"
        a(i, 4) = "Первая дата заказа"
        a(i, 5) = "Последняя дата заказа"

        For Each k In d1.keys
            i = i + 1
            a(i, 1) = k
            a(i, 2) = d1(k)
            a(i, 3) = d2(k)
            a(i, 4) = d3(k)
            a(i, 5) = d4(k)
        Next

        .Cells(1, 10).Resize(i, 5) = a
    End With
End Sub

 
Hugo, спасибо большое за помощь, с датами вопрос решен! Теперь буду разбираться, чтобы на будущее вопросов не возникала по таким задачам.

Hugo, Grr, благодарю, что откликнулись и помогли полезными советами новичку :D
 
На синей таблице правой кнопкой мыши -Обновить. Файл должен находиться в папке C:\1\
Неизлечимых болезней нет, есть неизлечимые люди.
 
Доброе время суток
TheBestOfTheBest, а зачем же так сложно? Вполне достаточно
Код
Select [№ клиента],[ФИО],Sum([сумма заказа]) As [Всего сумма заказа]
,Min([Дата заказа]) As [Первая дата заказа],Max([Дата заказа]) As [Последняя дата заказа]
From [изначально$] Group By [№ клиента],[ФИО]

Distinct при группировке не нужен никогда - повторяющихся строк не будет в любом случае.
Успехов.
Изменено: Андрей VG - 16.04.2015 02:15:38
 
TheBestOfTheBest, спасибо за еще один вариант по моему вопросу!
 
Hugo, не поможешь разобраться в ситуации? Попытался переложить твой код на реальную таблицу (~450 000 строк * 12 столбцов), но выкидывает в ошибку "Run-time error '13':Type mismatch" на строке:
Код
For Each k In d1.keys
Сокращаю таблицу ~ до 50 000 строк и все нормально отрабатывает. Данные по столбцам проанализировал, вроде всё нормально, разных типов нет.
 
alexss, Может он k считает за integer. Добавь в объявлении переменных после k "&"
т.е
Код
Dima(), i&, t$, k&
 
Нет, k As Variant попробуйте.
Вообще странная ошибка... Может ругается не на k, а на i, которая вдруг integer?
 
Grr, Hugo,
1) k as integer - точно нет, т.к. ругается что "ForEach"может быть только с Variant или Object
2) k As Variant - все равно выкидывал на той же строке в ошибку

Я уже подумал, что может ошибка всё таки в "t$"? Попробовал поменять на "As Variant", но теперь жутко тормозит. Сначала минут 15 ждал, надоело остановил. Недавно на др.компе запустил, уже минут 30 висит.
 
Пока непонятно.
Ошибку выбивает при первом же обращении к ключу, или где-то позже?
 
Hugo,
на "t as Variant" ошибку не выдал, ......но время выполнения макроса при обработке ~450 тыс.строк составило 6 ч.13 мин.!!!!
Как то совсем не хорошо.
При этом, когда изначально было "t$" и на 450 тыс.строк в ошибку кидал, я для пробы сокращал список тысяч до 50 строк и отрабатывало за 50-55 сек.
 
Значит где-то в данных ошибка, или формула выдала Н/Д.
Можно пробовать отсечь лишнее с помощью
Код
If not iserror(a(i, 1)) then
но правильно ли это? Я задачу в деталях уже не помню, но может лучше такие ячейки выявлять и о них сообщать - исправите ошибку (или сразу все собранные ошибки), запустите ещё раз.
Страницы: 1
Наверх