mitya528 (Все сообщения пользователя)

Ускорение расчета путем отказа от использования Select и расчет внутри макроса вместо расчета формулой

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

08.05.2024 13:34:16

Цитата
написал: пример приложите

Прикладываю, в модуль добавил 2 предложенных выше варианта и 2 моих исходных
Размер файла превышен, только если урезанную версию...

Изменено: mitya528 - 08.05.2024 13:37:00

Перейти

Ускорение расчета путем отказа от использования Select и расчет внутри макроса вместо расчета формулой

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

08.05.2024 13:19:36

Цитата
написал: Попробуйте так

время выполнения так же 1 секунда, спасибо
andypetr,

Цитата
написал: или даже так

так же 1 секунда, но вариант выглядит привлекательнее, спасибо

вопрос отказа от Select решен, время выполнения сохранилось - 1 секунда. Но вот хотелось бы отказаться от использования формулы совсем, чтобы внутри макроса, если можно с той же скоростью

Перейти

Ускорение расчета путем отказа от использования Select и расчет внутри макроса вместо расчета формулой

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

08.05.2024 12:50:54

Добрый день!
Часто замечал комментарии опытных пользователей о том что Select лучше не использовать, а расчеты можно произвести внутри макроса и привычными формулами не пользоваться вообще. Решил прислушаться, изменить свой расчетный файл, столкнулся с проблемой значительного увеличения затрачиваемого на расчеты времени.
например,
в ячейке P4 прописана формула =ЕСЛИОШИБКА(ОКРУГЛ(СРЗНАЧЕСЛИ($C4:$O4;">0");1);0)
макросом данная формула растягивается на весь диапазон, делается расчет, формулы переводятся в значения (на 200 тысяч строк затрачивается 1 секунда)

Код

Sub aaa()
Range("P4").AutoFill Destination:=Range("P4").Resize(Range("A4").End(xlDown).Row - Range("P4").Row + 1) 'растянуть формулу
    Calculate 'пересчитать
      Range("P5").Select 'выбрать ячейку
        Range(Selection, Selection.End(xlDown)).Select 'выделить вниз
          Selection.Copy 'копировать
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False 'вставить только значения
End Sub

После замены макроса на

Код

Sub AA()
On Error Resume Next 'в случае ошибки продолжить
PosStr = Sheets("Доп").UsedRange.Rows.Count 'переменная - количество строк
For n = 5 To PosStr 'с какой по какую строку
  Sheets("Доп").Range("P" & n) = Round(Application.AverageIfs(Sheets("Доп").Range("C" & n & ":O" & n), Sheets("Доп").Range("C" & n & ":O" & n), ">0"), 1) 
Next
End Sub

время выполнения расчета точно тех же данных в том же объеме возросло до 43 секунд.

неудачно подобрано решение для выполнения расчета? его следует чем либо дополнить, чтобы ускорить процесс?
Спасибо!

Перейти

Замена однотипных задач на одну, Оптимизация макроса

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

02.05.2024 11:59:20

Цитата
написал: Может, лучше явно указать лист

Пожалуй, не заметил, спасибо!

Перейти

Замена однотипных задач на одну, Оптимизация макроса

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

02.05.2024 11:52:29

Евгений Смирнов,

Цитата
написал: ("DM" & n)(1, c)

здесь вроде верно (я не знаю, проверить не успел)

Цитата
написал: Cells(12 + c, 2)

а здесь все так же, 12 столбец, вместо 117
но за вариант спасибо, лишним не будет, не знал, что в таком виде можно записать

Перейти

Замена однотипных задач на одну, Оптимизация макроса

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

02.05.2024 11:42:19

Апострофф,

Цитата
написал: 12 + C, N

столбцы и строки нужно местами поменять, и да, диапазон со 117 столбца начинается, а не с 12. За наводку спасибо, в целом решение правильное

Евгений Смирнов,

Цитата
написал: 12 + C, 2

тоже столбцы и строки перепутаны (как я понимаю Вы не все недочеты предыдущего варианта исправили), поэтому с первого раза запуск макроса не сработал, но в целом вариант самый удачный, его и оставлю у себя. Спасибо!

andypetr,

Цитата
написал: iColOffset

код сработал с первого раза, все хорошо, но предыдущий вариант выглядит привлекательнее, Спасибо за помощь!

Перейти

Замена однотипных задач на одну, Оптимизация макроса

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

02.05.2024 10:26:54

Добрый день, подскажите, как можно оптимизировать код

Код

Sheets("Доп").Range("DM" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DM2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 1

Sheets("Доп").Range("DN" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DN2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 2

Sheets("Доп").Range("DO" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DO2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 3

Sheets("Доп").Range("DP" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DP2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 4

Sheets("Доп").Range("DQ" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DQ2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 5

Sheets("Доп").Range("DR" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DR2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 6

Sheets("Доп").Range("DS" & n) = WorksheetFunction.Index((Sheets("Склады").Range("Y2:AG" & Cells(Rows.Count, 25).End(xlUp).Row)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("B" & n), Sheets("Склады").Range("Y2:Y" & Cells(Rows.Count, 25).End(xlUp).Row), 0)), _
                               (WorksheetFunction.Match(Sheets("Доп").Range("DS2"), Sheets("Склады").Range("Y1:AG1"), 0))) 'потребность по складу 7

по сути в 7 соседних столбцов через индекс(поискпоз) подставляются данные из одной таблицы, наверняка можно каким то образом заменить запись для 7 строк (по строке на каждый столбец) на одну универсальную запись, вот только не нашел информации как это сделать
Спасибо!

Перейти

Выведение результатов макроса на рабочий лист, отображение / не отображение результата расчета ( 0 и пусто )

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

02.05.2024 08:24:01

Всем доброго дня,
при использовании макроса заметил один момент, например:

Код
Sheets("Первый").Range("P" & n) = Round(Application.AverageIfs(Sheets("Первый").Range("C" & n & ":O" & n), Sheets("Первый").Range("C" & n & ":O" & n), ">0"), 1)

работает корректно, все замечательно, но, если все ячейки строки которая используется в расчете пустые (начиная со столбца "С" и до столбца "О") - в результат расчета не выводится ничего, то есть пусто (что меня вполне устраивает)
Однако, при другом расчете:

Код
Sheets("Первый").Range("R" & n) = Sheets("Второй").Range("Y" & n) + Sheets("Второй").Range("AB" & n)

используемые ячейки также могут быть абсолютно пустыми, но в результате расчета в ячейке отобразится "0".
От чего зависит такое выборочное отображение "0" и можно ли на это как то повлиять?
Мне например хотелось бы, чтобы при сложении двух пустых ячеек результат также оставался пустым (расчетов очень много, лишние нули только занимают используемые ресурсы), опять же, если скрытие "0" сильно усложнит сам код макроса и время его выполнения - от затеи можно и отказаться.
Спасибо!

Перейти

Макрос с формулами, Как прописать в макросе формулу, чтобы после его выполнения в ячейках уже был итог расчета, а не формула

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

02.05.2024 08:08:37

Еще раз большое спасибо evgeniygeo, неплохой старт в решении моих задач обеспечил)
с большей частью разобрался, если вдруг кому пригодится:

Код

Sub aaa()
PosStr = Sheets("Второй").UsedRange.Rows.Count ' конец диапазона (последняя строка), до которого нужно производить расчеты
For n = 5 To PosStr ' сам диапазон, начиная с 5 строки и до конца диапазона (PosStr)- последней строки
On Error Resume Next ' в случае ошибки продолжить выполнение макроса

Sheets("Первый").Range("P" & n) = Round(Application.AverageIfs(Sheets("Первый").Range("C" & n & ":O" & n), Sheets("Первый").Range("C" & n & ":O" & n), ">0"), 1) 'формула 1

Sheets("Первый").Range("R" & n) = Sheets("Второй").Range("Y" & n) + Sheets("Второй").Range("AB" & n) 'Формула 2

Sheets("Первый").Range("U" & n) = Application.WorksheetFunction.VLookup(Sheets("Первый").Range("A" & n), Sheets("Третий").Range("A:X"), 24, False) + _
                                  Application.WorksheetFunction.VLookup(Sheets("Первый").Range("A" & n), Sheets("Третий").Range("A:AA"), 27, False) 'Формула 3
                                  
Sheets("Первый").Range("Z" & n) = Sheets("Второй").Range("W" & n) + (Sheets("Второй").Range("AB" & n) / Sheets("Четвертый").Range("R3")) 'Формула 4

Sheets("Первый").Range("AC" & n) = Application.WorksheetFunction.VLookup(Sheets("Первый").Range("A" & n), Sheets("Третий").Range("A:V"), 22, False) + _
                                  (Application.WorksheetFunction.VLookup(Sheets("Первый").Range("A" & n), Sheets("Третий").Range("A:AA"), 27, False) / Sheets("Четвертый").Range("R6")) 'Формула 5
                                  
 If Sheets("Первый").Range("R" & n) = 0 Then 'если 0, то
 Sheets("Первый").Range("AG" & n) = "" 'ничего
 ElseIf Sheets("Первый").Range("Z" & n) > (Sheets("Первый").Range("AA" & n) * 1.25) Then 'если больше, то
 Sheets("Первый").Range("AG" & n) = "Рост" 'рост
 ElseIf Sheets("Первый").Range("Z" & n) < (Sheets("Первый").Range("AA" & n) * 0.75) Then 'если меньше, то
 Sheets("Первый").Range("AG" & n) = "Падение" ' падение
 End If 'конец блока если                                      ' формула 7

Sheets("Первый").Range("AW" & n) = Application.WorksheetFunction.Sum(Sheets("Первый").Range("AP" & n & ":AV" & n)) ' формула 8

Sheets("Первый").Range("AX" & n) = WorksheetFunction.Index((Sheets("Пятый").Range("O2:W" & Cells(Rows.Count, 15).End(xlUp).Row)), _
                                  (WorksheetFunction.Match(Sheets("Первый").Range("A" & n), Sheets("Пятый").Range("O2:O" & Cells(Rows.Count, 15).End(xlUp).Row), 0)), _
                                  (WorksheetFunction.Match(Sheets("Первый").Range("AX2"), Sheets("Пятый").Range("O1:W1"), 0))) ' формула 9

Sheets("Первый").Range("Y" & n) = Application.WorksheetFunction.VLookup(Sheets("Первый").Range("A" & n), Sheets("Третий").Range("A:W"), 23, False) ' формула 10 (в случае ошибки ячейка остается пустой, что само по себе равно 0)
                                  
Next 'продолжить (далее)
End Sub

Цитата

написал:
6.в столбец AJ, начиная с 4 строкиКод=ГИПЕРССЫЛКА("https://www.wildberries.ru/catalog/"&Лист2!E4&"/detail.aspx?target...)
*прописал в виде кода, чтобы не отображалось в виде ссылки. если такое вообще возможно, чтобы в ячейке отображалась сама ссылка, или слово "открыть", но не формула гиперссылки

эта задача пока остается не решенной, если для нее вообще есть решение.

Если вдруг у кого то возникнет желание дополнить тему, оптимизировать макрос - буду очень рад и признателен)

Изменено: mitya528 - 02.05.2024 08:25:04

Перейти

Макрос с формулами, Как прописать в макросе формулу, чтобы после его выполнения в ячейках уже был итог расчета, а не формула

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

27.04.2024 14:18:00

Цитата
написал: Одна задача- одна тема!

Понял, учту оба замечания

Перейти

Макрос с формулами, Как прописать в макросе формулу, чтобы после его выполнения в ячейках уже был итог расчета, а не формула

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

27.04.2024 13:59:36

Цитата
написал: добавил 1

И еще раз спасибо! уже далеко не первый раз Вы меня выручаете

Перейти

Макрос с формулами, Как прописать в макросе формулу, чтобы после его выполнения в ячейках уже был итог расчета, а не формула

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

27.04.2024 13:47:46

Цитата
написал: для самого простого примера

Большое спасибо!
Уверен, что даже частичное решение задумки положительно повлияет на результат

Перейти

Макрос с формулами, Как прописать в макросе формулу, чтобы после его выполнения в ячейках уже был итог расчета, а не формула

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

27.04.2024 13:44:49

Цитата
написал: В чем цель

цель ускорить сам процесс расчета, и дальнейшее использование итогов

Цитата
написал: Они долго обновляются?

да, в некоторые моменты возникают проблемы, причем на разных этапах (пересчет формулы, сохранение/открытие файла, большой размер самого файла

Цитата
написал: Вы представляете, сколько всего хотите сделать чужими руками

представляю, понимаю, что запрос выглядит весьма наглым, решил не создавать 10 разных тем, объединил в одну. если кто то может помочь и ему это не трудно - огромное спасибо, если мой запрос для кого то перебор - я понимаю, готов остаться ни с чем)
искал в интернете информацию, пробовал разные варианты - все не то, получить результат самостоятельно не смог. потому буду рад хотя бы частичной помощи, хоть наводка ... Дальше попробую додумать как это делается

Перейти

Макрос с формулами, Как прописать в макросе формулу, чтобы после его выполнения в ячейках уже был итог расчета, а не формула

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

27.04.2024 13:31:46

Доброго дня!
Прошу помощи перевести формулы в макрос, чтобы по нажатию кнопки нужные значения рассчитывались на весь массив и в конкретных ячейках был прописан итог расчета, а не формула по которой он посчитан

Сейчас формулы рассчитываются с 4 строки и до конца массива (он все время меняется, бывает 1 000 строк, бывает 200 000 строк) в качестве переменной для определения последней строки обработки на данный момент используется "PosStr" - последняя строка рабочей таблицы, ну или же можно ориентироваться на последнюю заполненную ячейку в столбце А, ниже уже расчеты не нужны

Пытался разобраться сам, но уже на простых формулах посыпалось все, до сложных даже не добрался, в 1 ячейке прописать сумму двух других не так сложно, а вот когда речь идет о целых столбцах....

Понимаю, что запрос весьма дерзкий, но если кому не сложно и есть свободное время...
Буду рад любой помощи, хоть 1-2 формулы уже огромный плюс
Спасибо!!!

сами формулы:
1. в столбец P, начиная с 4 строки
=ЕСЛИОШИБКА(ОКРУГЛ(СРЗНАЧЕСЛИ($C4:$O4;">0");1);0)

2.в столбец R, начиная с 4 строки
=Лист2!$Y4+Лист2!$AB4

3.в столбец U, начиная с 4 строки
=ЕСЛИОШИБКА(ВПР($A4;Лист5'!$A:$X;24;0)+ВПР($A4;'Лист5'!$A:$AA;27;0);0)

4.в столбец Z, начиная с 4 строки
=Лист2!$W4+Лист2!$AB4/'Лист7'!$R$3

5.в столбец AC, начиная с 4 строки
=ЕСЛИОШИБКА(ВПР($A4;'Лист5'!$A:$V;22;0)+ВПР($A4;'Лист5'!$A:$AA;27;0)/'Лист7'!$R$6;0)

6.в столбец AJ, начиная с 4 строки

Код
=ГИПЕРССЫЛКА("https://www.wildberries.ru/catalog/"&Лист2!E4&"/detail.aspx?targetUrl=GP";"открыть")

*прописал в виде кода, чтобы не отображалось в виде ссылки. если такое вообще возможно, чтобы в ячейке отображалась сама ссылка, или слово "открыть", но не формула гиперссылки

7.в столбец AG, начиная с 4 строки
=ЕСЛИ($R4=0;"";ЕСЛИ($Z4>$AA4*1,25;"Рост";ЕСЛИ($Z4<$AA4*0,75;"Падение";"")))

8.в столбец AW, начиная с 4 строки
=СУММ($AP4:$AV4)

9.в столбец AX, начиная с 4 строки
=ЕСЛИОШИБКА(ИНДЕКС(Лист3!$O$W;ПОИСКПОЗ($A4;Лист3!$O:$O;0);ПОИСКПОЗ(Лист1!$BA$2;Лист3!$O$1:$W$1;0));0)

10.в столбец Y, начиная с 4 строки
=ЕСЛИОШИБКА(ВПР($A4;'Лист5'!$A:$W;23;0);0)

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

26.04.2024 12:38:20

Цитата
написал: макросы в модуле книги

Спасибо тебе! добрый человек)
действительно, в модуле книги был макрос, который запрещает удалять строки, ради теста удалил его и 120 тысяч строк почистились за за 1 минуту.
для меня было не очевидно, что на 70 тысячах строк макрос не мешает, а на 120 замедляет процесс в 10 раз

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

26.04.2024 11:38:09

Цитата
написал: With Rows("3:250000") 'выбрать строку .ClearContents 'очистить .ClearFormats 'очистить End With

60 - 70 тысяч строк очищает за несколько десятков секунд (для меня вполне нормальный результат), 100 - 120 тысяч строк чистит более 10 минут.
Попробовал в несколько этапов - в макросе прописал чтобы сначала чистились первые 40 тысяч строк, затем еще 40 тысяч, и все что останется (так же 40 тысяч). В результате получил то же самое время (чуть больше 10 минут), но на 4 секунды больше(
С чем связана такая большая разница выполнения очистки? (понятное дело объем в 2 раза больше - времени на очистку нужно больше, но не в 10 ведь раз, тем более даже при очистке частями результат не меняется). Можно ли каким то образом оптимизировать процесс очистки для больших объемов?

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

25.04.2024 14:23:17

Цитата
написал: шаблон рабочей книги

за совет спасибо, но не все так просто. Шаблон то как раз создан (не совсем так, как Вы имели в виду, но он есть). Даже называется "Шаблон"))
вся загвоздка в том, что в этом шаблоне около 20 вкладок, штук 100 различных макросов, от самых простых до тех что посложнее, формул несколько сотен.... часть исходных данных постоянна (иногда дополняется), часть данных регулярно меняется (в нескольких вкладках сразу), периодически меняются условия - добавляются столбцы, редактируются формулы.....
Шаблон каждую неделю как то изменяется, дополняется, совершенствуется. на "пустую книгу" его не поменять
Причем процесс доработки шаблона часто происходит непосредственно во время расчетов, для того и придумана процедура очистки, чтобы уже на новые условия был готов шаблон

Перейти

Очистка данных, Очистка данных

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

25.04.2024 14:12:55

Цитата
написал: xls

а если xlsm и более 64К строк, условие дописывать не нужно? я пока успел протестировать на более мелких примерах, 1-2 К, не более

Перейти

Очистка данных, Очистка данных

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

25.04.2024 13:44:13

Цитата
написал: Sheets("два").

Спасибо! Думал все проще

Перейти

Очистка данных, Очистка данных

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

25.04.2024 13:30:46

Код

Sub aa()
Sheets("один").Select
   With Sheets("один").Range("A5:CX" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
     .ClearContents
     .ClearFormats
   End With

Sheets("два").Select
   With Sheets("два").Range("A5:EN" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
     .ClearContents
     .ClearFormats
   End With

            
End Sub

чистит все как и положено

Код

Sub aa()

   With Sheets("один").Range("A5:CX" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
     .ClearContents
     .ClearFormats
   End With

   With Sheets("два").Range("A5:EN" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
     .ClearContents
     .ClearFormats
   End With

            
End Sub

чистит на листе "один" (с него и запускается макрос) как положено, а на листе "два" чистит только первую строку нужного диапазона.
Почему?
хотел обойтись без "Sheets("два").Select", но почему то не работает

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

25.04.2024 10:40:37

Цитата
написал: Range("A3:P" & Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents

не подскажешь, а пожно ли одной строкой указать несколько диапазонов с разрывом?
например с ячейки А2 до столбца С, с ячейки F2 до столбца М, с ячейки Р2 до столбца Z. и все также последняя строка диапазонов не известна (End(xlUp).Row + 1)
?

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

25.04.2024 07:14:54

Цитата
написал: сократить диапазон

положительный эффект конечно будет, но это капля в море((
надеялся, что какие либо альтернативные варианты помимо ClearContents есть

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

mitya528 Пользователь Сообщений: 140 Регистрация: 01.11.2019	# 24.04.2024 16:29:43 evgeniygeo, обновляются вручную
	Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

24.04.2024 16:29:15

Конкретно для макроса по очистке на первый взгляд ничего не изменилось, он как выполнялся в самом конце работы, так и выполняется, как чистил 100 столбцов, так и чистит. Во втором столбце как была формула, так и осталась формула. Единственное изменение - была одна большая формула, условно на 100 символов (в каждой ячейке столбца) , а теперь в каждой ячейке более короткая формула, символов на 30-50 (но в разных строках формула может отличаться от предыдущей).

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

24.04.2024 16:24:35

Цитата
написал: стоит ли

стоит, в процессе расчёта некоторые коэффициенты обновляются, формулы пересчитываются

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

24.04.2024 16:01:56

Цитата
написал: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True

Уже есть, для примера часть макроса вставил, потому этого в примере нет.
пересчет формул и обновление экрана было отключено изначально, после обновления макроса никуда не делось (все что было изменено есть в примере) макрос по очистке стал работать в разы дольше, вот и хотел узнать у более опытных пользователей, с чем связано и как это решить
строки не обязательно чистить целиком, просто сам факт - изменилось совсем немногое, а время ожидания возросло в разы...

Изменено: mitya528 - 24.04.2024 16:03:00

Перейти

Быстрая очистка диапазона с данными (макрос), Оптимизация удаления (очистки) данных (макрос)

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

24.04.2024 15:42:56

Доброго времени суток, прошу помощи в оптимизации макросов.
Есть расчетный файл, в него ежедневно добавляются обновленные исходные данные, по этим данным производится расчет, результаты сохраняются в отдельный файл, исходные данные и расчеты из расчетного файла удаляются (на следующий день все тоже самое повторяется).
Данные удаляются именно очисткой содержимого ( и формата ячеек), а не путем удаления ячейки совсем.
Чистятся все строки кроме заголовка и первой строки с формулами и исходными данными.

Изначально, расчет производился по одной большой и сложной формуле, она охватывала не все случаи, усложнять формулу было с каждым разом все сложнее. Было принято решение определять какой именно случай представлен в исходных данных (каждая строка отдельно) и в зависимости от случая применять конкретную формулу для этого случая, а не одну большую универсальную.

Изначально, расчет производился по формуле, которая "растягивалась" на весь массив данных макросом:

Код
Sub Было_расчет() Range("B2").AutoFill Destination:=Range("B2").Resize(Range("A4").End(xlDown).Row - Range("B2").Row + 1) 'растянуть формулу Calculate End Sub

после того как формулу разделили на несколько более простых такой вариант уже не подходил, на этом форуме добрый человек подобрал решение:

Код

Sub Стало_расчет() 'ВПР основных формул
   Dim lastRow As Long 'пременная для определения нижней границы диапазона
     lastRow = Cells(Rows.Count, 1).End(xlUp).Row 'последняя строка по столбцу 1 (A)
       Application.ReferenceStyle = xlR1C1 'стиль ссылок R1C1
         FillFormulasRange Range(Cells(2, 2), Cells(lastRow, 2)), Range(Cells(2, 16), Cells(lastRow, 16)), Sheets("Стало").Range("T2:U6") 'подстановка формул по условию
           Calculate
       Application.ReferenceStyle = xlA1 'стиль ссылок А1
End Sub

Private Sub FillFormulasRange(rTarget As Range, rCondition As Range, rDictionary As Range) 'вспомогательное для ВПРа основных формул
    Dim dic As Object
    Set dic = GetDic(rDictionary)
    
    Dim aTrg As Variant
    Dim aCon As Variant
    aCon = rCondition.Value
    ReDim aTrg(1 To UBound(aCon, 1), 1 To 1)
    
    Dim yc As Long
    For yc = 1 To UBound(aCon, 1)
        If dic.Exists(aCon(yc, 1)) Then
            aTrg(yc, 1) = dic.Item(aCon(yc, 1))
        End If
    Next
    
    rTarget.Cells(1, 1).Resize(UBound(aTrg, 1), 1).FormulaR1C1 = aTrg
End Sub

Private Function GetDic(rr As Range) As Object 'вспомогательное для ВПРа основных формул
    Dim arr As Variant
    arr = rr.Columns(1).Resize(, 2).FormulaR1C1
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ya As Long
    For ya = 1 To UBound(arr, 1)
        dic.Item(arr(ya, 1)) = arr(ya, 2)
    Next
    Set GetDic = dic
End Function

Все работает, основной расчет стал значительно точнее. НО, после того как расчет произведен, расчетный файл нужно почистить, изначально использовался макрос:

Код
Sub Было_очистка() Rows("3:250000").Select 'выбрать строку Selection.Clear 'очистить End Sub

данный макрос стал в разы дольше выполнять свою задачу, обычно диапазон в 200 тысяч строк он чистил за считанные секунды, но после обновления макроса для расчета время выполнения очистки увеличилось до десятков минут.
Методом тыка макрос был изменен:

Код
Sub Стало_очистка() Rows("3:250000").Select 'выбрать строку Selection.ClearContents 'очистить Selection.ClearFormats 'очистить End Sub

Если сначала почистить содержимое ячейки а затем её формат - процесс протекает быстрее, но все равно занимает несколько минут. Основное время затрачивается именно на очистку столбца в который макросом были подставлены формулы для расчета, проверял неоднократно. Если перевести формулы в значения, процесс протекает быстрее, но на то чтобы "зазначить" формулы, тоже тратится время.

Внимание вопрос: можно ли каким то образом ускорить очистку ячеек? главное - не удалять ячейки/строки насовсем, а очистить их содержимое. как вариант зазначить диапазон перед очисткой, или вообще приравнять каждую ячейку к 0, а потом очистить диапазон. главное чтобы это было быстро

Заранее спасибо!

Изменено: mitya528 - 24.04.2024 15:44:37

Перейти

Предупреждение о том, что книга уже открыта, макрос

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

08.04.2024 07:01:45

Цитата
написал: UserStatus(1,1)

Спасибо, обязательно попробую

Перейти

Предупреждение о том, что книга уже открыта, макрос

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

08.04.2024 06:59:58

Цитата
написал: можно упростить,

Спасибо, обязательно попробую

Перейти

Предупреждение о том, что книга уже открыта, макрос

Пользователь

Сообщений: 140 Регистрация: 01.11.2019

05.04.2024 08:11:10

Код

Private Function myReadOnlyCheck(wb As Workbook) As Boolean
    If wb.ReadOnly Then
        myReadOnlyCheck = True
        MsgBox wb.Name & vbCrLf & "Попроси коллегу закрыть оригинал файла и нажми ''ОК''.", vbCritical, "Сейчас файл открыт только для чтения"
        wb.Close False
    End If
End Function

вот в таком виде после сообщения о том что файл уже у кого то открыт, можно попросить закрыть файл, нажать "ок" и все отработает как было задумано.
Осталось одно необязательное пожелание, хорошо бы в сообщении выводить имя пользователя который открыл файл

Код

Sub aaa()
    
  Application.ScreenUpdating = False  'отключаем обновление экрана для скорости

  Workbooks.Open Filename:="\\s\Files_server\Отдел\_ОБЩАЯ\С\Отбор.xlsm" 'открыть книгу
    Workbooks("Отбор.xlsm").Windows(1).WindowState = xlMaximized 'на первый план
      Workbooks("Отбор.xlsm").Activate 'на первый план
    If myReadOnlyCheck(ActiveWorkbook) Then

  Workbooks.Open Filename:="\\s\Files_server\Отдел\_ОБЩАЯ\С\Отбор.xlsm" 'открыть книгу
    Workbooks("Отбор.xlsm").Windows(1).WindowState = xlMaximized 'на первый план
      Workbooks("Отбор.xlsm").Activate 'на первый план
    
    End If 'конец блока если

  Sheets("ОП").Select 'выбрать лист
    Call Application.Run("'Отбор.xlsm'!Модуль.Очистка") 'запустить макрос
      Excel.ActiveWorkbook.Save 'сохранить книгу
        ActiveWorkbook.Close True 'закрыть книгу без подтверждения

  Sheets("Доп").Select 'выбрать лист
    Range("B4").Select 'выбрать ячейку
      Range(Selection, Selection.End(xlDown)).Select 'выделить вниз
        Selection.Copy 'копировать
          Sheets("Отбор").Select 'выбрать лист
            Range("A2").Select 'выбрать ячейку
              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False 'вставить только значения
     
  Sheets("Доп").Select 'выбрать лист
    Range("CA4").Select 'выбрать ячейку
      Range(Selection, Selection.End(xlDown)).Select 'выделить вниз
        Selection.Copy 'копировать
          Sheets("Отбор").Select 'выбрать лист
            Range("B2").Select 'выбрать ячейку
              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False 'вставить только значения
                   
  Sheets("Авто").Select 'выбрать лист
    Range("BZ4").Select 'выбрать ячейку
      Range(Selection, Selection.End(xlDown)).Select 'выделить вниз
        Selection.Copy 'копировать
          Sheets("Отбор").Select 'выбрать лист
            Range("C2").Select 'выбрать ячейку
              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False 'вставить только значения

  Range("A2:C2").Select 'выбрать диапазон
    Range(Selection, Selection.End(xlDown)).Select 'выделить вниз
      Selection.Copy 'копировать

  Workbooks.Open Filename:="\\s\Files_server\Отдел\_ОБЩАЯ\С\Отбор.xlsm" 'открыть книгу
    Workbooks("Отбор.xlsm").Windows(1).WindowState = xlMaximized 'на первый план
      Workbooks("Отбор.xlsm").Activate 'на первый план

    If myReadOnlyCheck(ActiveWorkbook) Then

  Workbooks.Open Filename:="\\s\Files_server\Отдел\_ОБЩАЯ\С\Отбор.xlsm" 'открыть книгу
    Workbooks("Отбор.xlsm").Windows(1).WindowState = xlMaximized 'на первый план
      Workbooks("Отбор.xlsm").Activate 'на первый план
    
    End If 'конец блока если
    

  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False 'вставить только значения
    Range("A2").Select 'выбрать ячейку
  
  Excel.ActiveWorkbook.Save 'сохранить книгу
  
    If Weekday(Date, 2) = 1 Then 'если сегодня понедельник
      Dim x As String
        strPath = "\\s\Files_server\Отдел\_ОБЩАЯ\С\Архив\Отбор"     'папка для сохранения резервной копии
      On Error Resume Next
        x = GetAttr(strPath) And 0
          If Err = 0 Then ' если путь существует - сохраняем копию книги, добавляя дату-время
            strDate = Format(Now, "dd.mm.yy hh.mm") 'формат сегодняшней даты и времени
              FileNameXls = strPath & "\" & "Отбор" & " " & strDate & ".xlsm" 'название и формат сохраняемого файла
                ActiveWorkbook.SaveCopyAs Filename:=FileNameXls 'сохранить объединив условия
          Else 'если путь не существует - выводим сообщение
            MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical 'сообщение в случае ошибки
          End If 'конец блока если
     End If 'конец блока если
     
  ActiveWorkbook.Close True 'закрыть книгу без подтверждения
    Application.ScreenUpdating = True 'включаем обновление экрана
End Sub 'конец

Перейти

Наверх