Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос для подсчета годовой статистики из имеющейся таблицы с разбивкой по месяцам
 
Уважаемые форумчане,

У меня есть ежемесячная статистика сдачи экзаменов по всем автошколам страны на все категории прав. В статьях нашла решение с помощью макроса, как ее консолидировать на один лист (вдруг поможет для дальнейшей обработки). Но не могу найти ни отдаленно похожего макроса/решения, чтобы посчитать статистику за год по каждой автошколе по всем типам экзаменов. Например, автошкола с кодом А0000, филиал 2, экзамен - теория, тип вод. удостоверения - В, кол-во сдавших за 2008 г. - 150 чел., кол-во не сдавших - 100 чел. Если бы не почти 4000 автошкол, уже бы забила и посчитала "вручную", но здесь нужен макрос для ускорения процесса, а своих знаний и умений писать код по образу и подобию на такую задачу уже не хватает.
Есть идеи, как это можно реализовать?

В прикрепленном файле привела для примера первые 50-60 строк за каждый месяц с января по март. В оригинальном варианте у меня по 36000 строк за каждый месяц.

Заранее всем спасибо!
 
Код
=СУММЕСЛИМН(J2:J150;C2:C150;C2;E2:E150;E2;H2:H150;H2;I2:I150;I2)

Очень сильно бы помог уникальный список всех кодов автошкол, всех типов экзаменов и всех категорий водительских удостоверений
Изменено: VideoAlex - 1 Дек 2018 14:22:02
 
Спасибо! В принципе, эта формула отвечает задаче, если не учитывать кол-во автошкол.
Список уникальных значений по кодам автошкол (самый большой по количеству), могу получить с помощью макроса из этой статьи: https://www.excel-vba.ru/chto-umeet-excel/kak-poluchit-spisok-unikalnyxne-povtoryayushhixsya-znachen...
Подсмотрела в полной версии файла, уникальных кодов автошкол 5211, остальное мелочи: типов экзаменов - 4, вод. удостоверений - 15. Но комбинаций по автошколе-экзамен-вод.удостоверений, сами представляете.
Без макроса не представляю, как это возможно.
 
Вы покажите в каком виде желательно/допустимо отображать отчет.
Как один из вариантов - сводная таблица.
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
srta_de_rubio, может быть Вам такое подойдет?

Код
Sub test()
Dim arr As Variant
lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
lLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
arr = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
Worksheets.Add.Name = "List1"
Set a = ThisWorkbook.Sheets("List1")
For i = 1 To lLastCol
a.Cells(1, i) = arr(1, i)
Next i
For i = 2 To UBound(arr)
For j = 2 To lLastRow
If arr(i, 3) = a.Cells(j, 3) _
And arr(i, 5) = a.Cells(j, 5) _
And arr(i, 8) = a.Cells(j, 8) _
And arr(i, 9) = a.Cells(j, 9) Then
For k = 10 To 16
a.Cells(j, k) = a.Cells(j, k) + arr(i, k)
Next k
Exit For
Else
If a.Cells(j, 3) = "" Then
For k = 1 To lLastCol
a.Cells(j, k) = arr(i, k)
Next k
a.Cells(j, 6) = ""
Exit For
End If
End If
Next j
Next i
End Sub
 
Цитата
Z написал:
Вы покажите в каком виде желательно/допустимо отображать отчет.
В идеале желательно в том же, что и изначальная таблица, только за минусом столбцов "месяц" и "год". Но форма все-таки здесь непринципиальна, лишь бы выполняла задачу.
Цитата
Z написал:
Как один из вариантов - сводная таблица.
Попробовала сделать сводную таблицу, на самом деле, думаю, это один из вариантов. Все считает, как надо, и достаточно быстро. Открыли мне глаза на стандартные возможности Excel. Углублюсь еще в тему сводных таблиц, чтобы убедиться, что использую все их возможности. Недостаток, который вижу на данный момент, это то, что общую статистику я хотела вывести за 2008 - 2018 гг., т.е. вначале подсчитать результаты по годам, а затем, на основе годовых результатов, сделать отчет за весь период. Насколько понимаю, тот формат таблицы, который я получаю через сводную таблицу, мне не подходит для создания следующей сводной таблицы.
 
Цитата
garnik написал:
srta_de_rubio , может быть Вам такое подойдет?
Спасибо большое! Это примерно то, что я себе и представляла, только не могла воплотить. В файле примера делает ровно то, что необходимо.

Попробовала запустить макрос в полном файле, но Excel задумывается очень глубоко и спустя час находится в состоянии "программа не отвечает".
Есть идеи, почему могло бы быть? Могло ли количество данных для обработки повлиять на работу макроса (в полном файле порядка 140 тыс. строк)?

В идеале, если получится с этим макросом, я бы использовала макрос для обработки годовой статистики, а затем сводную таблицу для объединения данных за весь период 2008-2018 гг.
 
Возможно из-за большого количества строк произошло зависание Excel. Вычисления производились на листе, поэтому возможно длительное выполнение кода. Ниже код с вычислениями в массиве, я думаю это ускорит работу макроса, также добавил отбор по году, в случае обработки с 2008 по 2018 год.

Код
Sub test()
Dim nov() As Variant
Dim arr() As Variant
lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
lLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
arr = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
Worksheets.Add.Name = "List1"
Set a = ThisWorkbook.Sheets("List1")
ReDim nov(1 To UBound(arr), 1 To 16)
    For i = 1 To lLastCol
        nov(1, i) = arr(1, i)
    Next i
        For i = 2 To UBound(arr)
            For j = 2 To lLastRow
                If arr(i, 3) = nov(j, 3) _
                    And arr(i, 5) = nov(j, 5) _
                    And arr(i, 8) = nov(j, 8) _
                    And arr(i, 9) = nov(j, 9) _
                    And arr(i, 7) = nov(j, 7) Then
                        For k = 10 To 16
                            nov(j, k) = nov(j, k) + arr(i, k)
                        Next k
                        Exit For
                Else
                        If nov(j, 3) = "" Then
                            For k = 1 To lLastCol
                                nov(j, k) = arr(i, k)
                            Next k
                                nov(j, 6) = ""
                            Exit For
                        End If
                End If
            Next j
        Next i
a.Range(Cells(1, 1), Cells(UBound(nov), 16)) = nov
End Sub


У меня обработка 190 тыс. строк заняла 15 секунд
Изменено: garnik - 2 Дек 2018 14:51:41
 
garnik, Вы что-нибудь слышали про форматирование кода? Я про табуляцию в данном случае ))
 
Юрий М, да, конечно слышал, но на практике пока не применяю, учусь пока коды писать, до профессионального уровня мне еще далеко, но буду стараться в будущем выкладывать коды с учетом форматирования. На данный момент пока, что для меня главное работоспособность кода.
 
Но, согласитесь, что читабельность отформатированного кода гораздо выше )
И при отладке значительно легче.
 
Цитата
garnik написал: но буду стараться в будущем
OFF Глубоко ошибочный подход - сразу надо правильно осваивать и закреплять навыки. От "If" на свой "End If" как вы считаете удобнее попасть?!. ;)  
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Друзья, согласен с Вами обоими, исправлюсь)
 
Цитата
garnik написал:
У меня обработка 190 тыс. строк заняла 15 секунд
Спасибо большое, что не бросаете меня наедине с кодом. Но все равно зависает. Я уже всю таблицу скопировала на новый лист, на случай если с UsedRange как-то не так определяется, но не помогло. С удовольствием бы здесь прикрепила весь файл, но он 27Мб весит...

Может быть я код в VBA неправильно добавляю? Alt+F11 вызываю редактор VBA, затем Вставка - Модуль. В окне модуля вставляю код. Пробовала запускать непосредственно из редактора и как макрос из списка доступных макросов (Alt+F8).
Изменено: srta_de_rubio - 2 Дек 2018 17:06:35 (добавлен вопрос)
 
srta_de_rubio, остановите макрос после строки lLastCol =... и посмотрите, чему равны переменные lLastRow и lLastCol.
А вообще с UsedRange нужно быть осторожнее.
 
Цитата
Юрий М написал:
остановите макрос после строки lLastCol =... и посмотрите, чему равны переменные lLastRow и lLastCol.
Проверила, считает правильно. Только когда ранее давала ориентировочное количество строк для garnik, , не знаю, куда смотрела: вместо порядка 140 тыс. строк у меня порядка 400-500 тыс. строк, в зависимости от года...

чересчур много, да?
 
Я думаю, что при 500 000 строк должно отработать без зависания. Только времени потребуется больше, чем при 130 000. В сам код не вникал...
Сколько столбцов в реальной таблице?
 
Цитата
Юрий М написал:
Сколько столбцов в реальной таблице?
16 столбцов.

Попробовала сейчас обработать только за 2 месяца данные, порядка 70 тыс. строк. Пока висит... минут 5-7 уже.
 
srta_de_rubio, сейчас запустил код отрабатываю 500 тыс. строк, но вся загвоздка в том что всевозможных комбинаций, которые получаются также тысячи, поэтому макрос так долго отрабатывает. В итоге Excel не висит, а выполняется программа.
Изменено: garnik - 2 Дек 2018 21:01:41
 
Выводите информацию в СтатусБар. Например, номер каждой сотой строки - тогда можно будет видеть, что процесс идёт )  
 
Z, Юрий М, спасибо за советы!
garnik, огроменное спасибо за код!

В итоге макрос работает, проблема была в терпении, точнее его нехватке. Два месяца (порядка 70-80 тыс. строк) обрабатывает за 25-30 мин. Рискнула еще раз запустить на полном файле с 400 тыс. строк и уехала с друзьями обедать, чтобы не гипнотизировать комп. Ушло 160 мин. на обработку. Вполне приемлимо для моих нужд, всего-то надо за 10 лет обработать данные.  
Страницы: 1
Читают тему (гостей: 1)
Наверх