Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Очень долгое выполнение кода - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Очень долгое выполнение кода (Макросы/Sub)
Очень долгое выполнение кода
Markovich Дата: Вторник, 23.02.2021, 19:28 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Доброго времени суток уважаемые форумчане! Делаю первые робкие шаги в написании макросов и на подводные камни наталкиваюсь на каждом шагу. Решаю следующую задачу: есть форма, в нее из разных источников копируются диапазоны строк, в определенных ячейках есть формулы, которые либо несовместимы с текущей версией формы, либо при вставке получаются ненужные ссылки на источник, но так же в этих ячейках могут быть и значения (которые не рассчитываются формулами, а вводятся вручную). Написал макрос, который в определенные ячейки, содержащие формулы, либо пустые перезаписывает формулы с эталона. Количество строк в таблице варьируется от 150 до >3000. Макрос работает, но проблема в том что жутко тормозит, когда количество строк 150 макрос выполняется около 45 секунд, а вот когда 3000 строк, то через час я так и не дождался окончания операции и завершил excel через диспетчер задач (так и не знаю завершился бы процесс или excel завис). Выключением обновления экрана и переводом в ручной пересчет мои попытки оптимизировать закончились. Подскажите, пожалуйста, можно ли как то оптимизировать макрос?
[vba]
Код
Sub RecoveryFormula_Partly()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    With Sheets("Вводные данные")
        For i = 11 To [Full]
        Worksheets("service1").Cells(1, 1).Copy .Cells(i, 1)
            If Cells(i, 6).HasFormula Or Cells(i, 6) = "" Then
                Worksheets("service1").Cells(1, 6).Copy .Cells(i, 6)
            End If
        Worksheets("service1").Cells(1, 12).Copy .Cells(i, 12)
            If Cells(i, 13).HasFormula Or Cells(i, 13) = "" Then
                Worksheets("service1").Cells(1, 13).Copy .Cells(i, 13)
            End If
            If Cells(i, 14).HasFormula Or Cells(i, 14) = "" Then
                Worksheets("service1").Cells(1, 14).Copy .Cells(i, 14)
            End If
            If Cells(i, 15).HasFormula Or Cells(i, 15) = "" Then
                Worksheets("service1").Cells(1, 15).Copy .Cells(i, 15)
            End If
            If Cells(i, 16).HasFormula Or Cells(i, 16) = "" Then
                Worksheets("service1").Cells(1, 16).Copy .Cells(i, 16)
            End If
            If Cells(i, 17).HasFormula Or Cells(i, 17) = "" Then
                Worksheets("service1").Cells(1, 17).Copy .Cells(i, 17)
            End If
        Worksheets("service1").Cells(1, 18).Copy .Cells(i, 18)
            If Cells(i, 19).HasFormula Or Cells(i, 19) = "" Then
                Worksheets("service1").Cells(1, 19).Copy .Cells(i, 19)
            End If
            If Cells(i, 20).HasFormula Or Cells(i, 20) = "" Then
                Worksheets("service1").Cells(1, 20).Copy .Cells(i, 20)
            End If
        Worksheets("service1").Cells(1, 21).Resize(1, 2).Copy .Cells(i, 21).Resize(1, 2)
            If Cells(i, 23).HasFormula Or Cells(i, 23) = "" Then
                Worksheets("service1").Cells(1, 23).Copy .Cells(i, 23)
            End If
            If Cells(i, 24).HasFormula Or Cells(i, 24) = "" Then
                Worksheets("service1").Cells(1, 24).Copy .Cells(i, 24)
            End If
            If Cells(i, 25).HasFormula Or Cells(i, 25) = "" Then
                Worksheets("service1").Cells(1, 25).Copy .Cells(i, 25)
            End If
        Worksheets("service1").Cells(1, 26).Copy .Cells(i, 26)
            If Cells(i, 27).HasFormula Or Cells(i, 27) = "" Then
                Worksheets("service1").Cells(1, 27).Copy .Cells(i, 27)
            End If
            If Cells(i, 28).HasFormula Or Cells(i, 28) = "" Then
                Worksheets("service1").Cells(1, 28).Copy .Cells(i, 28)
            End If
            If Cells(i, 29).HasFormula Or Cells(i, 29) = "" Then
                Worksheets("service1").Cells(1, 29).Copy .Cells(i, 29)
            End If
            If Cells(i, 33).HasFormula Or Cells(i, 33) = "" Then
                Worksheets("service1").Cells(1, 33).Copy .Cells(i, 33)
            End If
        Worksheets("service1").Cells(1, 34).Resize(1, 2).Copy .Cells(i, 34).Resize(1, 2)
            If Cells(i, 36).HasFormula Or Cells(i, 36) = "" Then
                Worksheets("service1").Cells(1, 36).Copy .Cells(i, 36)
            End If
        Next
    End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
[/vba]
Спасибо.
 
Ответить
СообщениеДоброго времени суток уважаемые форумчане! Делаю первые робкие шаги в написании макросов и на подводные камни наталкиваюсь на каждом шагу. Решаю следующую задачу: есть форма, в нее из разных источников копируются диапазоны строк, в определенных ячейках есть формулы, которые либо несовместимы с текущей версией формы, либо при вставке получаются ненужные ссылки на источник, но так же в этих ячейках могут быть и значения (которые не рассчитываются формулами, а вводятся вручную). Написал макрос, который в определенные ячейки, содержащие формулы, либо пустые перезаписывает формулы с эталона. Количество строк в таблице варьируется от 150 до >3000. Макрос работает, но проблема в том что жутко тормозит, когда количество строк 150 макрос выполняется около 45 секунд, а вот когда 3000 строк, то через час я так и не дождался окончания операции и завершил excel через диспетчер задач (так и не знаю завершился бы процесс или excel завис). Выключением обновления экрана и переводом в ручной пересчет мои попытки оптимизировать закончились. Подскажите, пожалуйста, можно ли как то оптимизировать макрос?
[vba]
Код
Sub RecoveryFormula_Partly()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    With Sheets("Вводные данные")
        For i = 11 To [Full]
        Worksheets("service1").Cells(1, 1).Copy .Cells(i, 1)
            If Cells(i, 6).HasFormula Or Cells(i, 6) = "" Then
                Worksheets("service1").Cells(1, 6).Copy .Cells(i, 6)
            End If
        Worksheets("service1").Cells(1, 12).Copy .Cells(i, 12)
            If Cells(i, 13).HasFormula Or Cells(i, 13) = "" Then
                Worksheets("service1").Cells(1, 13).Copy .Cells(i, 13)
            End If
            If Cells(i, 14).HasFormula Or Cells(i, 14) = "" Then
                Worksheets("service1").Cells(1, 14).Copy .Cells(i, 14)
            End If
            If Cells(i, 15).HasFormula Or Cells(i, 15) = "" Then
                Worksheets("service1").Cells(1, 15).Copy .Cells(i, 15)
            End If
            If Cells(i, 16).HasFormula Or Cells(i, 16) = "" Then
                Worksheets("service1").Cells(1, 16).Copy .Cells(i, 16)
            End If
            If Cells(i, 17).HasFormula Or Cells(i, 17) = "" Then
                Worksheets("service1").Cells(1, 17).Copy .Cells(i, 17)
            End If
        Worksheets("service1").Cells(1, 18).Copy .Cells(i, 18)
            If Cells(i, 19).HasFormula Or Cells(i, 19) = "" Then
                Worksheets("service1").Cells(1, 19).Copy .Cells(i, 19)
            End If
            If Cells(i, 20).HasFormula Or Cells(i, 20) = "" Then
                Worksheets("service1").Cells(1, 20).Copy .Cells(i, 20)
            End If
        Worksheets("service1").Cells(1, 21).Resize(1, 2).Copy .Cells(i, 21).Resize(1, 2)
            If Cells(i, 23).HasFormula Or Cells(i, 23) = "" Then
                Worksheets("service1").Cells(1, 23).Copy .Cells(i, 23)
            End If
            If Cells(i, 24).HasFormula Or Cells(i, 24) = "" Then
                Worksheets("service1").Cells(1, 24).Copy .Cells(i, 24)
            End If
            If Cells(i, 25).HasFormula Or Cells(i, 25) = "" Then
                Worksheets("service1").Cells(1, 25).Copy .Cells(i, 25)
            End If
        Worksheets("service1").Cells(1, 26).Copy .Cells(i, 26)
            If Cells(i, 27).HasFormula Or Cells(i, 27) = "" Then
                Worksheets("service1").Cells(1, 27).Copy .Cells(i, 27)
            End If
            If Cells(i, 28).HasFormula Or Cells(i, 28) = "" Then
                Worksheets("service1").Cells(1, 28).Copy .Cells(i, 28)
            End If
            If Cells(i, 29).HasFormula Or Cells(i, 29) = "" Then
                Worksheets("service1").Cells(1, 29).Copy .Cells(i, 29)
            End If
            If Cells(i, 33).HasFormula Or Cells(i, 33) = "" Then
                Worksheets("service1").Cells(1, 33).Copy .Cells(i, 33)
            End If
        Worksheets("service1").Cells(1, 34).Resize(1, 2).Copy .Cells(i, 34).Resize(1, 2)
            If Cells(i, 36).HasFormula Or Cells(i, 36) = "" Then
                Worksheets("service1").Cells(1, 36).Copy .Cells(i, 36)
            End If
        Next
    End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
[/vba]
Спасибо.

Автор - Markovich
Дата добавления - 23.02.2021 в 19:28
Апострофф Дата: Вторник, 23.02.2021, 20:06 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 337
Репутация: 101 ±
Замечаний: 0% ±

Excel 1997
Markovich, вместо этого
[vba]
Код
Worksheets("service1").Cells(1, 1).Copy .Cells(i, 1)
[/vba]

попробуйте это
[vba]
Код
.Cells(i, 1).FORMULA = Worksheets("service1").Cells(1, 1).FORMULA
[/vba]
К тому же присваивать можно не поячеечно и в цикле, а целыми диапазонами.
Думаю, это многократно повысить скорость.
 
Ответить
СообщениеMarkovich, вместо этого
[vba]
Код
Worksheets("service1").Cells(1, 1).Copy .Cells(i, 1)
[/vba]

попробуйте это
[vba]
Код
.Cells(i, 1).FORMULA = Worksheets("service1").Cells(1, 1).FORMULA
[/vba]
К тому же присваивать можно не поячеечно и в цикле, а целыми диапазонами.
Думаю, это многократно повысить скорость.

Автор - Апострофф
Дата добавления - 23.02.2021 в 20:06
bmv98rus Дата: Вторник, 23.02.2021, 20:14 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3464
Репутация: 602 ±
Замечаний: 0% ±

Excel 2013/2016
Markovich, что бросается сразу в глаза, так это то что вы работаете с 3 листами
1. With Sheets("Вводные данные")
2. Worksheets("service1")
3. и активный лист If Cells(i, 6)
что нужно без примера не понять, но в любом случае лучше или сразу определить листы типа set SServ= Worksheets("service1") ...

Цитата Апострофф, 23.02.2021 в 20:06, в сообщении № 2 ()
попробуйте это
не факт, может нужно копировать и формат, но это относится к вопросу не понятно с чем работает и что нужно получить.


Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Вторник, 23.02.2021, 20:27
 
Ответить
СообщениеMarkovich, что бросается сразу в глаза, так это то что вы работаете с 3 листами
1. With Sheets("Вводные данные")
2. Worksheets("service1")
3. и активный лист If Cells(i, 6)
что нужно без примера не понять, но в любом случае лучше или сразу определить листы типа set SServ= Worksheets("service1") ...

Цитата Апострофф, 23.02.2021 в 20:06, в сообщении № 2 ()
попробуйте это
не факт, может нужно копировать и формат, но это относится к вопросу не понятно с чем работает и что нужно получить.

Автор - bmv98rus
Дата добавления - 23.02.2021 в 20:14
Markovich Дата: Вторник, 23.02.2021, 22:10 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Апострофф, спасибо. переделал как понял из Вашей рекомендации:
[vba]
Код
.Cells(i, 1).FORMULA = Worksheets("service1").Cells(1, 1).FORMULA
[/vba]
поллучилось:
[vba]
Код
Sub RecoveryFormula_Partly_test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    With Sheets("Вводные данные")
        For i = 11 To [Full]
        .Cells(i, 1).Formula = Worksheets("service1").Cells(1, 1).Formula
            If Cells(i, 6).HasFormula Or Cells(i, 6) = "" Then
                .Cells(i, 6).Formula = Worksheets("service1").Cells(1, 6).Formula
            End If
        .Cells(i, 12).Formula = Worksheets("service1").Cells(1, 12).Formula
            If Cells(i, 13).HasFormula Or Cells(i, 13) = "" Then
                .Cells(i, 13).Formula = Worksheets("service1").Cells(1, 13).Formula
            End If
            If Cells(i, 14).HasFormula Or Cells(i, 14) = "" Then
                .Cells(i, 14).Formula = Worksheets("service1").Cells(1, 14).Formula
            End If
            If Cells(i, 15).HasFormula Or Cells(i, 15) = "" Then
                .Cells(i, 15).Formula = Worksheets("service1").Cells(1, 15).Formula
            End If
            If Cells(i, 16).HasFormula Or Cells(i, 16) = "" Then
                .Cells(i, 16).Formula = Worksheets("service1").Cells(1, 16).Formula
            End If
        Next
    End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
[/vba]
Макрос стал работать однозначно быстрее, но как то странно... Там где в ячейку копируется формула из эталонной без условия работает четко, а где есть условие, то вылезает кривизна: копирование с эталонна преобразовывается в вид:
Код
=IF(INDEX(service!$AX:$AX,ROW())="","",INDEX(service!$AX:$AX,ROW()))
и формат ячейки становится текстовым, а в оригинале в ячейку должна быть скопирована формула:
Код
=ЕСЛИ(ИНДЕКС(service!$AX:$AX;СТРОКА())="";"";ИНДЕКС(service!$AX:$AX;СТРОКА()))
. В чем может быть ошибка?
Цитата
К тому же присваивать можно не поячеечно и в цикле, а целыми диапазонами.

Извините, я понимаю о чем речь, но не понимаю как реализовать. Можно немного подробнее объяснить?
 
Ответить
СообщениеАпострофф, спасибо. переделал как понял из Вашей рекомендации:
[vba]
Код
.Cells(i, 1).FORMULA = Worksheets("service1").Cells(1, 1).FORMULA
[/vba]
поллучилось:
[vba]
Код
Sub RecoveryFormula_Partly_test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    With Sheets("Вводные данные")
        For i = 11 To [Full]
        .Cells(i, 1).Formula = Worksheets("service1").Cells(1, 1).Formula
            If Cells(i, 6).HasFormula Or Cells(i, 6) = "" Then
                .Cells(i, 6).Formula = Worksheets("service1").Cells(1, 6).Formula
            End If
        .Cells(i, 12).Formula = Worksheets("service1").Cells(1, 12).Formula
            If Cells(i, 13).HasFormula Or Cells(i, 13) = "" Then
                .Cells(i, 13).Formula = Worksheets("service1").Cells(1, 13).Formula
            End If
            If Cells(i, 14).HasFormula Or Cells(i, 14) = "" Then
                .Cells(i, 14).Formula = Worksheets("service1").Cells(1, 14).Formula
            End If
            If Cells(i, 15).HasFormula Or Cells(i, 15) = "" Then
                .Cells(i, 15).Formula = Worksheets("service1").Cells(1, 15).Formula
            End If
            If Cells(i, 16).HasFormula Or Cells(i, 16) = "" Then
                .Cells(i, 16).Formula = Worksheets("service1").Cells(1, 16).Formula
            End If
        Next
    End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
[/vba]
Макрос стал работать однозначно быстрее, но как то странно... Там где в ячейку копируется формула из эталонной без условия работает четко, а где есть условие, то вылезает кривизна: копирование с эталонна преобразовывается в вид:
Код
=IF(INDEX(service!$AX:$AX,ROW())="","",INDEX(service!$AX:$AX,ROW()))
и формат ячейки становится текстовым, а в оригинале в ячейку должна быть скопирована формула:
Код
=ЕСЛИ(ИНДЕКС(service!$AX:$AX;СТРОКА())="";"";ИНДЕКС(service!$AX:$AX;СТРОКА()))
. В чем может быть ошибка?
Цитата
К тому же присваивать можно не поячеечно и в цикле, а целыми диапазонами.

Извините, я понимаю о чем речь, но не понимаю как реализовать. Можно немного подробнее объяснить?

Автор - Markovich
Дата добавления - 23.02.2021 в 22:10
Markovich Дата: Вторник, 23.02.2021, 23:19 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
bmv98rus, на самом деле работаю с двумя листами "Вводные данные" и "service1", если получается три листа, значит скривил. Что нужно поправить? Все делаю по аналогии с тем что увидел или подсказали. Понимаю, что нужно учить с нуля, как говорится "учите матчасть", но совсем другая профессия, времени не хватает катастрофически.
Цитата
сразу определить листы типа set SServ= Worksheets("service1")
не совсем понял о чем речь, если не сложно объясните про что речь, изучу вопрос.
Цитата
может нужно копировать и формат

да, формат копировать тоже нужно.
Прилагаю пример. В "Вводные данные" вносится информация и вручную, и из других источников, добавляются, вставляются и удаляются строки, поэтому формулы в ячейках могут искажаться. В белых ячейках формул нет, только вводные данные, в розовых ячейках только формулы (как информационные), в зеленых ячейках формулы, т.е. предлагается какой то расчет, но можно внести значение вручную (если расчет по-умолчанию не устраивает). Все расчеты ведутся на листе "service" (в данном вопросе он не участвует), на листе "service1" находится эталонная строка. Т.о., например, скопировал откуда то строки, в розовых и зеленых ячейках формулы получились кривые, причем в зеленых могут быть значения, которые трогать нельзя. Вот я и заново макросом переписываю все ячейки, где есть формулы, формулами из эталонной строки, не трогая значения. Наверное не самый удачный алгоритм, но постоянно работаю над усовершенствованием. Частично из-за этого и получаются несовместимые источник и приемник при копировании.
К сообщению приложен файл: 1538274.xls(114.0 Kb)


Сообщение отредактировал Markovich - Вторник, 23.02.2021, 23:22
 
Ответить
Сообщениеbmv98rus, на самом деле работаю с двумя листами "Вводные данные" и "service1", если получается три листа, значит скривил. Что нужно поправить? Все делаю по аналогии с тем что увидел или подсказали. Понимаю, что нужно учить с нуля, как говорится "учите матчасть", но совсем другая профессия, времени не хватает катастрофически.
Цитата
сразу определить листы типа set SServ= Worksheets("service1")
не совсем понял о чем речь, если не сложно объясните про что речь, изучу вопрос.
Цитата
может нужно копировать и формат

да, формат копировать тоже нужно.
Прилагаю пример. В "Вводные данные" вносится информация и вручную, и из других источников, добавляются, вставляются и удаляются строки, поэтому формулы в ячейках могут искажаться. В белых ячейках формул нет, только вводные данные, в розовых ячейках только формулы (как информационные), в зеленых ячейках формулы, т.е. предлагается какой то расчет, но можно внести значение вручную (если расчет по-умолчанию не устраивает). Все расчеты ведутся на листе "service" (в данном вопросе он не участвует), на листе "service1" находится эталонная строка. Т.о., например, скопировал откуда то строки, в розовых и зеленых ячейках формулы получились кривые, причем в зеленых могут быть значения, которые трогать нельзя. Вот я и заново макросом переписываю все ячейки, где есть формулы, формулами из эталонной строки, не трогая значения. Наверное не самый удачный алгоритм, но постоянно работаю над усовершенствованием. Частично из-за этого и получаются несовместимые источник и приемник при копировании.

Автор - Markovich
Дата добавления - 23.02.2021 в 23:19
nilem Дата: Пятница, 26.02.2021, 09:18 | Сообщение № 6
Группа: Авторы
Ранг: Старожил
Сообщений: 1589
Репутация: 551 ±
Замечаний: 0% ±

Excel 2013, 2016
Markovich, привет
попробуйте:


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Пятница, 26.02.2021, 09:19
 
Ответить
СообщениеMarkovich, привет
попробуйте:

Автор - nilem
Дата добавления - 26.02.2021 в 09:18
Markovich Дата: Пятница, 26.02.2021, 16:40 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
nilem, здравствуйте! большое спасибо за код, работает быстро, 150 строк обрабатывает за 0,41с, а 3000 строк за 14с, а ни как у меня в оригинале зависало до бесконечности. Очень здорово! Обязательно изучу код, оптимизирую другие свои нешустрые макросы. hands


Сообщение отредактировал Markovich - Пятница, 26.02.2021, 16:45
 
Ответить
Сообщениеnilem, здравствуйте! большое спасибо за код, работает быстро, 150 строк обрабатывает за 0,41с, а 3000 строк за 14с, а ни как у меня в оригинале зависало до бесконечности. Очень здорово! Обязательно изучу код, оптимизирую другие свои нешустрые макросы. hands

Автор - Markovich
Дата добавления - 26.02.2021 в 16:40
Апострофф Дата: Четверг, 04.03.2021, 02:09 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 337
Репутация: 101 ±
Замечаний: 0% ±

Excel 1997
If Len(x(i, 6)) = 0 Or InStr(x(i, 6), "=") Then x(i, 6) = rng(1, 6).Formula

[vba]
Код
If rr.HasFormula = True Then
MsgBox "Every cell in the selection contains a formula"
End If
[/vba]
А если "=" внутри текста? Всё равно это ФОРМУЛА?


Сообщение отредактировал Апострофф - Четверг, 04.03.2021, 02:10
 
Ответить
Сообщение
If Len(x(i, 6)) = 0 Or InStr(x(i, 6), "=") Then x(i, 6) = rng(1, 6).Formula

[vba]
Код
If rr.HasFormula = True Then
MsgBox "Every cell in the selection contains a formula"
End If
[/vba]
А если "=" внутри текста? Всё равно это ФОРМУЛА?

Автор - Апострофф
Дата добавления - 04.03.2021 в 02:09
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Очень долгое выполнение кода (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!