Добрый день. Просьба помочь оптимизировать макрос. Есть файл(файл с макросом добавил во вложение) с однородными данными в колонках A-C. Нужно создать структуру/группировку + для каждого уровня добавить по строке где будут прописаны формулы (промежуточные итоги, максимумы и т. д.)
Написал макрос для этой цели. Макрос работает, но метод который я использовал медленный. Файл с 200 тис. строк группировал около часа(и это макрос прописывал только 2 формулы, а будет больше). Метод банальный, макрос проверяет значения верхней и нижней ячеек в колонке, если они одинаковые то ничего не делаем, если они разные - значит нужно добавить строку и сгруппировать строки выше. Подскажите, пожалуйста, как ускорить мой макрос.
[vba]
Код
Option Explicit
Sub Group_0_1() Application.ScreenUpdating = False Application.DisplayAlerts = False
Dim nach, i, k, kon, LC As Long Dim a, B, col1, col2 As Variant Dim st#, Message$, fsh#
' пром итоги и другие формулы k = kon - nach + 1 Range("I" & nach).Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[1]C:R[" & k & "]C)" Selection.AutoFill Destination:=Range("I" & nach & ":J" & nach), Type:=xlFillDefault
Rows(nach + 1 & ":" & kon + 1).Select Selection.Rows.Group nach = i + 2: i = i + 1: LC = LC + 1 End If Next i
' Уровень 2 nach = 2 For i = 2 To LC a = Cells(i, 2).Value B = Cells(i + 1, 2).Value If a = B Then
' пром итоги и другие формулы k = kon - nach + 1 Range("I" & nach).Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[1]C:R[" & k & "]C)" Selection.AutoFill Destination:=Range("I" & nach & ":J" & nach), Type:=xlFillDefault
Rows(nach + 1 & ":" & kon + 1).Select Selection.Rows.Group nach = i + 2 i = i + 1 LC = LC + 1 ' нужно обновить значения счетчика, у меня пока не получилось End If Next i
fsh = Timer Message = MsgBox("Все ОК! Время работы макроса: " & (fsh - st) \ 60 & " мин. " & (fsh - st) Mod 60 & " сек.", vbExclamation, "ГОТОВО") Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
[/vba]
В дальнейшем, чтобы для каждого из 3х уровней не дублировать одинаковый код, помещу его в цикл(действия одинаковые, разница в номере колонки).
P.S. Еще есть проблема с счетчиком цикла. Нужно перебрать все ячейки со 2й по последнюю. For i = 2 To LC. (LC = Sheets("рабочий").Range("A1").End(xlDown).Row - узнаю последнюю ячейку в файле), но так как в цикле нужно добавлять строки, количество которых я не знаю, цикл останавливаеться до перебора всех ячеек. Придумал "костыль" добавить к LC +100(число которое больше чем добавляться строк). Можно как то обновить значение счетчика LC внутри цикла?
Спасибо!
Добрый день. Просьба помочь оптимизировать макрос. Есть файл(файл с макросом добавил во вложение) с однородными данными в колонках A-C. Нужно создать структуру/группировку + для каждого уровня добавить по строке где будут прописаны формулы (промежуточные итоги, максимумы и т. д.)
Написал макрос для этой цели. Макрос работает, но метод который я использовал медленный. Файл с 200 тис. строк группировал около часа(и это макрос прописывал только 2 формулы, а будет больше). Метод банальный, макрос проверяет значения верхней и нижней ячеек в колонке, если они одинаковые то ничего не делаем, если они разные - значит нужно добавить строку и сгруппировать строки выше. Подскажите, пожалуйста, как ускорить мой макрос.
[vba]
Код
Option Explicit
Sub Group_0_1() Application.ScreenUpdating = False Application.DisplayAlerts = False
Dim nach, i, k, kon, LC As Long Dim a, B, col1, col2 As Variant Dim st#, Message$, fsh#
' пром итоги и другие формулы k = kon - nach + 1 Range("I" & nach).Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[1]C:R[" & k & "]C)" Selection.AutoFill Destination:=Range("I" & nach & ":J" & nach), Type:=xlFillDefault
Rows(nach + 1 & ":" & kon + 1).Select Selection.Rows.Group nach = i + 2: i = i + 1: LC = LC + 1 End If Next i
' Уровень 2 nach = 2 For i = 2 To LC a = Cells(i, 2).Value B = Cells(i + 1, 2).Value If a = B Then
' пром итоги и другие формулы k = kon - nach + 1 Range("I" & nach).Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[1]C:R[" & k & "]C)" Selection.AutoFill Destination:=Range("I" & nach & ":J" & nach), Type:=xlFillDefault
Rows(nach + 1 & ":" & kon + 1).Select Selection.Rows.Group nach = i + 2 i = i + 1 LC = LC + 1 ' нужно обновить значения счетчика, у меня пока не получилось End If Next i
fsh = Timer Message = MsgBox("Все ОК! Время работы макроса: " & (fsh - st) \ 60 & " мин. " & (fsh - st) Mod 60 & " сек.", vbExclamation, "ГОТОВО") Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
[/vba]
В дальнейшем, чтобы для каждого из 3х уровней не дублировать одинаковый код, помещу его в цикл(действия одинаковые, разница в номере колонки).
P.S. Еще есть проблема с счетчиком цикла. Нужно перебрать все ячейки со 2й по последнюю. For i = 2 To LC. (LC = Sheets("рабочий").Range("A1").End(xlDown).Row - узнаю последнюю ячейку в файле), но так как в цикле нужно добавлять строки, количество которых я не знаю, цикл останавливаеться до перебора всех ячеек. Придумал "костыль" добавить к LC +100(число которое больше чем добавляться строк). Можно как то обновить значение счетчика LC внутри цикла?
Код смотрел по диагонали, просто не очень интересно 1. для ускорения отключите пересчет. То что отключено отображение и предупреждении не отключают расчет при изменениях на листах, а при вставке строк и формул пересчет запускается. 2. цикл FOR можно заменить на While/Dо , и лучше держать счетчик строк определенный в начале и прибавлять к нему во время вставки нужное количество.
Код смотрел по диагонали, просто не очень интересно 1. для ускорения отключите пересчет. То что отключено отображение и предупреждении не отключают расчет при изменениях на листах, а при вставке строк и формул пересчет запускается. 2. цикл FOR можно заменить на While/Dо , и лучше держать счетчик строк определенный в начале и прибавлять к нему во время вставки нужное количество.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Я правильно понял, нужно в начало добавить Application.Calculation = xlCalculationManual, а в конец Application.Calculation = xlCalculationAutomatic? Я думал что отключение пересчета негативно повлияет на вставку формул.
Перепишу цикл на While/Dо.
После вставки строк я добавлял к счетчику +1 но что то не помогло, подскажите что я сделал не так:
[vba]
Код
..... LC = Sheets("рабочий").Range("A1").End(xlDown).Row '(припустим получилось LC = 1000 ) For i = 2 To LC
' Добавить строку
LC = LC + 1
Next i
[/vba] В режиме отладки в конце работы макроса LC был, например, 1050, а цикл останавлевался на предыдущим значении (LC = 1000)
bmv98rus, Спасибо за советы.
Я правильно понял, нужно в начало добавить Application.Calculation = xlCalculationManual, а в конец Application.Calculation = xlCalculationAutomatic? Я думал что отключение пересчета негативно повлияет на вставку формул.
Перепишу цикл на While/Dо.
После вставки строк я добавлял к счетчику +1 но что то не помогло, подскажите что я сделал не так:
[vba]
Код
..... LC = Sheets("рабочий").Range("A1").End(xlDown).Row '(припустим получилось LC = 1000 ) For i = 2 To LC
' Добавить строку
LC = LC + 1
Next i
[/vba] В режиме отладки в конце работы макроса LC был, например, 1050, а цикл останавлевался на предыдущим значении (LC = 1000)
не внимательно прочли совет, я не говорил продолжить использовать For он определяет границы изменения переменной один раз и как бы не менялась значение LC потом, на количество циклов не повлияет.
не внимательно прочли совет, я не говорил продолжить использовать For он определяет границы изменения переменной один раз и как бы не менялась значение LC потом, на количество циклов не повлияет.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
1. Бегите по строкам снизу вверх 2. засуньте данные в массив и оттуда уже сравнивайте [vba]
Код
nach = 2 n_ = Cells(Rows.Count, 1).End(3).Row - nach + 1 ar1 = Cells(nach, 3).Resize(n_) For i = n_ To nach Step -1 If ar1(i, 1) <> ar1(i - 1, 1) Then
[/vba]
3. К теме не относится, но все-таки[vba]
Код
Dim nach, i, k, kon, LC As Long
[/vba] 'почитайте про объявление переменных. Long только LС
4. Выделите таблицу - вкладка Данные - Промежуточный итог. Там поиграйтесь (снимите 3 галки внизу) для групп и потом для менеджеров (поверх того, что уже сделали для групп). Потом попробуйте записать все это макросом. Возможно подойдет
1. Бегите по строкам снизу вверх 2. засуньте данные в массив и оттуда уже сравнивайте [vba]
Код
nach = 2 n_ = Cells(Rows.Count, 1).End(3).Row - nach + 1 ar1 = Cells(nach, 3).Resize(n_) For i = n_ To nach Step -1 If ar1(i, 1) <> ar1(i - 1, 1) Then
[/vba]
3. К теме не относится, но все-таки[vba]
Код
Dim nach, i, k, kon, LC As Long
[/vba] 'почитайте про объявление переменных. Long только LС
4. Выделите таблицу - вкладка Данные - Промежуточный итог. Там поиграйтесь (снимите 3 галки внизу) для групп и потом для менеджеров (поверх того, что уже сделали для групп). Потом попробуйте записать все это макросом. Возможно подойдет_Boroda_
_Boroda_, Алексанра, а вот не совсем согласная я, 1. сложнее определить порой начало конец блока, но не видя данных сказать сложно. по этом и да и нет. 2. мне кажется основные тормоза не из-за перебора а именно из-а вставки.
_Boroda_, Алексанра, а вот не совсем согласная я, 1. сложнее определить порой начало конец блока, но не видя данных сказать сложно. по этом и да и нет. 2. мне кажется основные тормоза не из-за перебора а именно из-а вставки.
сложнее определить порой начало конец блока, но не видя данных сказать сложно. по этом и да и нет.
2. Безусловно. Нро если уж все равно вставляем, то лучше уж хоть как-то ускорить
3. или можно не вставлять. Создать еще один массив (в 2 раза больший исходного - 2n) и заполнять его данными из первого массива и расчетными формулами. Вот здесь уже цикл сверху вниз нужен будет. Потом вставить второй массив на лист вместо первого. И отдельно в том же цикле сделать массив n х 3, который (не весь, а сколько получится группировок) будем заполнять строками начала и окончания и уровнем группировок. Потом пробегаемся по этому массиву и лепим группировки на листе
4. Но все равно гораздо быстрее будет использовать встроенные возможности
сложнее определить порой начало конец блока, но не видя данных сказать сложно. по этом и да и нет.
2. Безусловно. Нро если уж все равно вставляем, то лучше уж хоть как-то ускорить
3. или можно не вставлять. Создать еще один массив (в 2 раза больший исходного - 2n) и заполнять его данными из первого массива и расчетными формулами. Вот здесь уже цикл сверху вниз нужен будет. Потом вставить второй массив на лист вместо первого. И отдельно в том же цикле сделать массив n х 3, который (не весь, а сколько получится группировок) будем заполнять строками начала и окончания и уровнем группировок. Потом пробегаемся по этому массиву и лепим группировки на листе
4. Но все равно гораздо быстрее будет использовать встроенные возможности
3. К теме не относится, но все-таки Dim nach, i, k, kon, LC As Long 'почитайте про объявление переменных. Long только LС
В готовом файле будет строк около 200тис. nach, i, kon, LC - это номера строк, их значение может быть до 200к, а у Integer диапазон до 32767. А k(длина промежуточного итога) сделаю Integer'ом =)
зато с этим Dim a, B, col1, col2 As Variant получилось как надо :-)
Да, тут "психанул" не был уверен каким типом данных цвет объявлять, думал временно поставлю Variant, а потом вернусь и исправлю, нооо.. "Ничто так не постоянно, как временное"(с)
3. К теме не относится, но все-таки Dim nach, i, k, kon, LC As Long 'почитайте про объявление переменных. Long только LС
В готовом файле будет строк около 200тис. nach, i, kon, LC - это номера строк, их значение может быть до 200к, а у Integer диапазон до 32767. А k(длина промежуточного итога) сделаю Integer'ом =)
зато с этим Dim a, B, col1, col2 As Variant получилось как надо :-)
Да, тут "психанул" не был уверен каким типом данных цвет объявлять, думал временно поставлю Variant, а потом вернусь и исправлю, нооо.. "Ничто так не постоянно, как временное"(с)Iurii
Сообщение отредактировал Iurii - Вторник, 23.07.2019, 16:19
4. Выделите таблицу - вкладка Данные - Промежуточный итог. Там поиграйтесь (снимите 3 галки внизу) для групп и потом для менеджеров (поверх того, что уже сделали для групп). Потом попробуйте записать все это макросом. Возможно подойдет
Так пробовал, получается не очень. Промежуточный итог не всегда правильно итоговые строки вставляет, а макросом я могу строки вставлять куда хочу и прописывать формулы какие хочу.
- нужно так
- получается вот так, а если поиграться и сверху так как нужно сделать, то ниже группироваться будет не так как надо. При чем странно что есть 2 похожих файла, в одном встроенным методом группировки отлично группирует и строит иерархию, а во втором путает местами итоги
4. Выделите таблицу - вкладка Данные - Промежуточный итог. Там поиграйтесь (снимите 3 галки внизу) для групп и потом для менеджеров (поверх того, что уже сделали для групп). Потом попробуйте записать все это макросом. Возможно подойдет
Так пробовал, получается не очень. Промежуточный итог не всегда правильно итоговые строки вставляет, а макросом я могу строки вставлять куда хочу и прописывать формулы какие хочу.
- нужно так
- получается вот так, а если поиграться и сверху так как нужно сделать, то ниже группироваться будет не так как надо. При чем странно что есть 2 похожих файла, в одном встроенным методом группировки отлично группирует и строит иерархию, а во втором путает местами итоги
В готовом файле будет строк около 200тис. nach, i, kon, LC - это номера строк
Вот Вам и написали, что при вашей записи только LC будет Long , а всё что до этого автоматом Variant. То что работает, это тольок по тому что оно включает любой тип.
В готовом файле будет строк около 200тис. nach, i, kon, LC - это номера строк
Вот Вам и написали, что при вашей записи только LC будет Long , а всё что до этого автоматом Variant. То что работает, это тольок по тому что оно включает любой тип.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
