Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Оптимизация (ускорение) работы макроса
 
#1
15.09.2021 09:42:31
Всем привет!
Написал макрос, который в зависимости от значения в ячейках на листе скрывает/ отображает строки, а также скрывает/ отображает другие листы в книге.
Проблема в том, что на некоторых компах после открытия файла этот лист скачет и прыгает если нажимать на ячейки, визуальный эффект чем-то похож на многократную перезагрузку сайта в браузере.
Я везде повтыкал Application.ScreenUpdating, но не помогает.
Помогите плиз оптимизировать (ускорить) код, чтобы убрать этот эффект. Ну и вообще буду рад советам.

Макрос:
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ReportData(71) As Variant
Dim i As Integer
Dim j As Integer
Dim MaxNew As Integer
Dim KeyError As Integer
Dim RecentDate As Variant

Set isect = Application.Intersect(Target, Range("Retro_period"))
If Not isect Is Nothing Then
    If isect.Interior.Color = ColorJ1 Then
        isect.Interior.Color = ColorG1
    Else
        isect.Interior.Color = ColorJ1
    End If
    Set isect = Nothing
    
    MaxNew = 0
    RecentDate = Format(Range("Даты").Item(Range("Даты").Count).Value, 0)
    For Each C In Range("Retro_period")
    If C.Interior.Color = ColorG1 Then
        If Format(C.Value, 0) < RecentDate Then
        ReportData(MaxNew) = C.Value
        MaxNew = MaxNew + 1
        End If
    End If
    Next
    
    j = Range("Даты").Count
    For i = j - 1 To 1 Step -1
        If MaxNew >= j - i Then
        Range("Даты").Item(i).Value = ReportData(MaxNew - j + i)
        Else
        Range("Даты").Item(i).Value = Empty
        End If
    Next
End If

'---- Крыжики
If Target.Interior.Pattern = xlGray8 Then
Application.ScreenUpdating = False
On Error GoTo Errhandler
    If Target.Value = "" Then
              Target.Value = "V"
        Else: Target.Value = ""
    End If
    Exit Sub
Application.ScreenUpdating = True
End If

'---- КНР
If Range("S8") = "V" Then
Application.ScreenUpdating = False
Range("S10") = ""
Rows("9:10").Hidden = True
Worksheets("BS_PL_RC").Visible = False
Worksheets("ОФР_КНР").Visible = False
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
Rows("9:10").Hidden = False
Worksheets("BS_PL_RC").Visible = True
Worksheets("ОФР_КНР").Visible = True
Application.ScreenUpdating = True
End If


'---- Инвест
If Range("Prjct_type") = Worksheets("Справочник").Range("pt_1") And Range("Q8") = "Заемщик" Then
Application.ScreenUpdating = False
Worksheets("BS_PL").Visible = True
Worksheets("Analytics").Visible = True
Worksheets("CFS").Visible = True
Worksheets("Budget").Visible = True
Worksheets("ОХРП").Visible = True
Worksheets("Бюджет_фин").Visible = True
Worksheets("Бюджет_контр").Visible = True
Worksheets("Финансир-е").Visible = True
Worksheets("Погашение").Visible = True
Worksheets("ДДС").Visible = True
Worksheets("ОФР").Visible = True
Worksheets("КП").Visible = True
Worksheets("ДЗ_КЗ").Visible = True
Worksheets("ФМ").Visible = True
Worksheets("Обеспеч").Visible = True
Worksheets("Суд").Visible = True
Worksheets("ФС_ДР").Visible = True
Worksheets("ОХРП_ДО").Visible = False
Worksheets("ОХРП_Олимп").Visible = False
Rows("11:17").Hidden = False
Application.ScreenUpdating = True

'---- Док
ElseIf Range("Prjct_type") = Worksheets("Справочник").Range("pt_2") Then
Application.ScreenUpdating = False
Worksheets("BS_PL").Visible = True
Worksheets("Analytics").Visible = True
Worksheets("CFS").Visible = False
Worksheets("ОХРП_ДО").Visible = True
Worksheets("Budget").Visible = False
Worksheets("ОХРП").Visible = False
Worksheets("Бюджет_фин").Visible = False
Worksheets("Бюджет_контр").Visible = False
Worksheets("Финансир-е").Visible = False
Worksheets("Погашение").Visible = False
Worksheets("ДДС").Visible = False
Worksheets("ОФР").Visible = False
Worksheets("КП").Visible = False
Worksheets("ДЗ_КЗ").Visible = False
Worksheets("ФМ").Visible = False
Worksheets("Обеспеч").Visible = False
Worksheets("Суд").Visible = False
Worksheets("ФС_ДР").Visible = False
Worksheets("ОХРП_Олимп").Visible = False
Range("N12:N17") = ""
Rows("11:17").Hidden = True
Application.ScreenUpdating = True

'---- Экспортн
ElseIf Range("Prjct_type") = Worksheets("Справочник").Range("pt_3") Then
Application.ScreenUpdating = False
Worksheets("BS_PL").Visible = True
Worksheets("Analytics").Visible = True
Worksheets("CFS").Visible = True
Worksheets("Budget").Visible = True
Worksheets("ОХРП").Visible = True
Worksheets("Бюджет_фин").Visible = True
Worksheets("Бюджет_контр").Visible = True
Worksheets("Финансир-е").Visible = True
Worksheets("Погашение").Visible = True
Worksheets("ДДС").Visible = True
Worksheets("ОФР").Visible = True
Worksheets("КП").Visible = True
Worksheets("ДЗ_КЗ").Visible = True
Worksheets("ФМ").Visible = True
Worksheets("Обеспеч").Visible = True
Worksheets("Суд").Visible = True
Worksheets("ФС_ДР").Visible = True
Worksheets("ОХРП_ДО").Visible = False
Worksheets("ОХРП_Олимп").Visible = False
Rows("11:17").Hidden = False
Application.ScreenUpdating = True


'---- Олим
ElseIf Range("Prjct_type") = Worksheets("Справочник").Range("pt_4") Then
Application.ScreenUpdating = False
Worksheets("BS_PL").Visible = True
Worksheets("Analytics").Visible = True
Worksheets("CFS").Visible = True
Worksheets("ОХРП_Олимп").Visible = True
Worksheets("Budget").Visible = False
Worksheets("ОХРП").Visible = False
Worksheets("Бюджет_фин").Visible = False
Worksheets("Бюджет_контр").Visible = False
Worksheets("Финансир-е").Visible = False
Worksheets("Погашение").Visible = False
Worksheets("ДДС").Visible = False
Worksheets("ОФР").Visible = False
Worksheets("КП").Visible = False
Worksheets("ДЗ_КЗ").Visible = False
Worksheets("ФМ").Visible = False
Worksheets("Обеспеч").Visible = False
Worksheets("Суд").Visible = False
Worksheets("ФС_ДР").Visible = False
Worksheets("ОХРП_ДО").Visible = False
Range("N12:N17") = ""
Rows("11:17").Hidden = True
Application.ScreenUpdating = True



'---- Иные - скрыть все листы
Else
Application.ScreenUpdating = False
Worksheets("BS_PL").Visible = False
Worksheets("Analytics").Visible = False
Worksheets("CFS").Visible = False
Worksheets("Budget").Visible = False
Worksheets("ОХРП").Visible = False
Worksheets("Бюджет_фин").Visible = False
Worksheets("Бюджет_контр").Visible = False
Worksheets("Финансир-е").Visible = False
Worksheets("Погашение").Visible = False
Worksheets("ДДС").Visible = False
Worksheets("ОФР").Visible = False
Worksheets("КП").Visible = False
Worksheets("ДЗ_КЗ").Visible = False
Worksheets("ФМ").Visible = False
Worksheets("Обеспеч").Visible = False
Worksheets("Суд").Visible = False
Worksheets("ФС_ДР").Visible = False
Worksheets("ОХРП_ДО").Visible = False
Worksheets("ОХРП_Олимп").Visible = False
Range("N12:N17") = ""
Rows("11:17").Hidden = True
Application.ScreenUpdating = True
End If

'---- График
If Range("N12") = "V" Then
Application.ScreenUpdating = False
Worksheets("График").Visible = True
Else
Worksheets("График").Visible = False
Application.ScreenUpdating = True
End If

'---- Производство
If Range("N13") = "V" Then
Application.ScreenUpdating = False
Worksheets("Произ-во").Visible = True
Else
Worksheets("Произ-во").Visible = False
Application.ScreenUpdating = True
End If

'---- Обороты
If Range("N14") = "V" Then
Application.ScreenUpdating = False
Worksheets("Обороты").Visible = True
Else
Worksheets("Обороты").Visible = False
Application.ScreenUpdating = True
End If

'---- Структура выручи и себестоимости
If Range("N15") = "V" Then
Application.ScreenUpdating = False
Worksheets("В_С").Visible = True
Else
Worksheets("В_С").Visible = False
Application.ScreenUpdating = True
End If

'---- Ковенанты
If Range("N16") = "V" Then
Application.ScreenUpdating = False
Worksheets("Ковенанты").Visible = True
Else
Worksheets("Ковенанты").Visible = False
Application.ScreenUpdating = True
End If



Errhandler:
End Sub
 
 
 
#2
15.09.2021 09:48:01
Попробуй убрать Application.ScreenUpdating везде и добавь в начале кода Application.ScreenUpdating = false, а в завершение true.  
 
 
 
#3
15.09.2021 09:49:30
Здравствуйте! Сделайте запуск макроса с кнопки, например.
 
 
 
#4
15.09.2021 09:51:29
Ещё можно попробовать автопересчет формул отключить. А если где нужно то пересчитать.  
 
 
 
#5
15.09.2021 10:00:45
Цитата
Pavel1234 написал:
Попробуй убрать Application.ScreenUpdating везде и добавь в начале кода Application.ScreenUpdating = false, а в завершение true.  
Сделал, вроде немного лучше, но сам эффект до конца не пропал.
Цитата
Настя_Nastya написал:
Здравствуйте! Сделайте запуск макроса с кнопки, например.
Нужно, чтобы в динамике менялось все.

Цитата
Pavel1234 написал:
Ещё можно попробовать автопересчет формул отключить. А если где нужно то пересчитать.  
Ох, это точно не подойдет, там дальше листы для ввода данных и много расчетных формул.
 
 
 
#6
15.09.2021 10:08:15
Попробуйте что-то из этого: Как ускорить и оптимизировать код VBA
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#7
15.09.2021 10:16:24
Может попробовать изменить схему запуска макрос с Worksheet_SelectionChange на Worksheet_Change
 
 
 
#8
15.09.2021 10:17:30
где можно уже от расчитаных значений выполнять логику макрос с отключеным пересчётом, а где нужно принудительно пересчитать там включать автопересчет или разово пересчитать и выполнять макрос дальше. А в завершении включить. Результат должен получиться тот же, а время затраченное меньше.  
 
 
 
#9
15.09.2021 10:25:37
Код
If Range("N12") = "V" Then
Application.ScreenUpdating = False
Worksheets("График").Visible = True
Else
Worksheets("График").Visible = False
Application.ScreenUpdating = True
End If

так не делается  у вас отключение срабатывает только когда истина и включение когда ложь
как написано выше в самом начале кода отключили обновление
Application.ScreenUpdating = False
после того как все сделали
Application.ScreenUpdating = True

такое как
Скрытый текст

записать
Код
Worksheets(array("BS_PL","Analytics","CFS")).Visible = True
Worksheets(array("ОХРП_Олимп","Budget","ОХРП","Бюджет_фин","Бюджет_контр","Финансир-е" ...... )).Visible = False
Изменено: БМВ - 15.09.2021 10:33:21
По вопросам из тем форума, личку не читаю.
 
 
 
#10
15.09.2021 10:28:08
Цитата
New написал:
Может попробовать изменить схему запуска макрос с Worksheet_SelectionChange на Worksheet_Change
Некоторые части макроса выбивают ошибку, если так сделать.

Цитата
Pavel1234 написал:
где можно уже от расчитаных значений выполнять логику макрос с отключеным пересчётом, а где нужно принудительно пересчитать там включать автопересчет или разово пересчитать и выполнять макрос дальше. А в завершении включить. Результат должен получиться тот же, а время затраченное меньше.  
На листе, где есть этот макрос практически нет формул и вычислений. Попробовал включить ручной пересчет формул, вообще не помогло.
Цитата
Дмитрий(The_Prist) Щербаков написал:
Попробуйте что-то из этого:  Как ускорить и оптимизировать код VBA
Попробую, спасибо.

Тут проблема с мельканием экрана, странно, но по идее Application.ScreenUpdating должен помогать, но не помогает.
Мне кажется, что у меня код какой-то тяжелый и его можно переделать в какой-то более оптимизированный вид, не знаю что еще может быть... но проблема только с этим листом в книге с этим макросом.
 
 
 
#11
15.09.2021 10:33:12
Мелькает потому, что вы в коде то выключаете обновление экрана, то снова включаете его.
Обычно делают так - в начале кода пишут
Application.ScreenUpdating = False
А в конце макроса пишут
Application.ScreenUpdating = True
И всё.
А у вас через строчку - выключить/включить, выключить/включить ...
 
 
 
#12
15.09.2021 10:33:44
Цитата
Мне кажется, что у меня код какой-то тяжелый
В этой теме - общие рекомендации по оптимизации.
 
 
 
#13
15.09.2021 10:34:07
Цитата
New написал:
А у вас через строчку - выключить/включить, выключить/включить ...
все хуже №9
По вопросам из тем форума, личку не читаю.
 
 
 
#14
15.09.2021 10:36:48
Цитата
БМВ написал:
так не делается  у вас отключение срабатывает только когда истина и включение когда ложькак написано выше в самом начале кода отключили обновление Application.ScreenUpdating = Falseпосле того как все сделалиApplication.ScreenUpdating = True
Исправил.

Цитата
БМВ написал:
записать
Выдает ошибку - Нельзя установить свойство Visible для класса Sheets.
 
 
 
#15
15.09.2021 10:46:29
Цитата
Max написал:
Выдает ошибку -
да, скрыть можно показать так нет
По вопросам из тем форума, личку не читаю.
 
 
 
#16
15.09.2021 10:57:50
По моему. много времени может тратиться на обращение к Excel  в циклах For.. Next - строки 20-27 и 30-36.
Код будет работать быстрее, если записать значения ячеек и цвет (Value, Color) либо в массив, либо в variant и работать с ними в коде.
Так же не менять значение ячеек в строках 32 и 34  на каждой итерации цикла, а создать два Range, и обновлять их адреса (например через Union) и обновить значения после окончания цикла.
 
 
 
Страницы: 1
Наверх