Страницы: 1
RSS
VBA: обработка 900 строк занимает более 1,5 минут
 
Товарищи, подскажите где я "накрутил" ненужное или куда думать чтоб оптимизировать код:
Код
Sub EditNextYear(ByRef yeargraf As Integer, wbName As String)

Dim DatListObj As ListObject
Dim DatListRow As ListRow

    With Workbooks(wbName).Sheets("график ТО")
        .Activate
'    редактирование нового графика ТО
        .Range("grafik_TO_tb[дата ТО/ диагн.]").ClearContents
        .Range("grafik_TO_tb[№ акта ТО]").ClearContents
        .Range("grafik_TO_tb[дата согласов.]").ClearContents
        .Range("grafik_TO_tb[организация проводившая ТО]").ClearContents
        .Range("grafik_TO_tb[дата след. ТО]").Cut Range("grafik_TO_tb[дата ТО/ диагн.]")
    End With
    
Set DatListObj = Workbooks(wbName).Worksheets("график ТО").ListObjects("grafik_TO_tb")
Set DatListRow = DatListObj.ListRows(1)

    yeargraf = Year(DatListRow.Range(13))
    
    For Each DatListRow In DatListObj.ListRows
        If DatListRow.Range(17).Value <> "" Then
            DatListRow.Range(12).Value = DatListRow.Range(17).Value
            DatListRow.Range(17).Value = ""
        End If
        If DatListRow.Range(25).Value <> "" And Year(DatListRow.Range(25)) = yeargraf - 1 Then
            DatListRow.Range(12).Value = DatListRow.Range(25).Value
        End If
        If DatListRow.Range(27).Value <> "запрет" Then
            If Year(DatListRow.Range(27)) = yeargraf Or Year(DatListRow.Range(27)) < yeargraf Then
                DatListRow.Range(31).Value = "диагностика"
            Else
                DatListRow.Range(31).Value = "т/о"
            End If
        End If
    Next DatListRow
    
    Workbooks(wbName).Sheets("график ТО").Range("grafik_TO_tb[дата ТО/ диагн.]").NumberFormat = "mmm/yyyy"

End Sub

всё работает корректно, но долго.
 
Для начала отключите обновление экрана, и поставьте ручной пересчёт (если это не сделано в вызывающем коде).
ну а далее, если ускорения недостаточно, как уже подсказали на другом форуме - переходите на массивы.
 
обновление экрана отключено в вызывающей процедуре. А как ручной пересчет поставить? Не приходилось пока.
 
Можно вручную, можно вручную и записать в макрос - увидите.
Не забудьте затем вернуть назад.
 
Добавлю также свои 5 копеек: в этом макросе скорее всего наибольшие потери времени происходят в момент записи значения в ячейку (а это, в свою очередь, скорее всего происходит из-за пересчета формул на листе), но в другом случае - можно не так быстро понять.

Поэтому, чтобы сузить проблемную область - можно померять время исполнения каждой из операций (например, выводя информацию в immediate window)

в блоке объявления переменных

Код
Dim TimeMacro: TimeMacro = Timer

После каждого блока кода, который хотите померять

Код
Debug.print Format(Timer-TimeMacro, "0.00")
TimeMacro = Timer

Тогда вы сможете конкретнее искать информацию/спрашивать - например, как ускорить выполнение этих строчек кода
Изменено: Yaroslav_T - 22.03.2018 10:41:54
 
Цитата
etrusk написал:
With Workbooks(wbName).Sheets("график ТО")
       .Activate
.Activate мало того, что лишнее - может еще и к ошибке привести, если на момент выполнения кода активной является не книга wbName.
Цитата
etrusk написал:
If DatListRow.Range(17).Value <> "" Then
считывание, и тем более присвоение значений ячеек происходит не быстро. А у Вас это в каждой итерации цикла делается. Если перейти на массивы - уверен, макрос будет в разы быстрее выполняться.
Ну и как уже говорили - отключение автопересчета формул, отключение разбиения на страницы, отслеживания событий - тоже не помешает.
Я чуть более подробно про оптимизацию описывал здесь: Как ускорить и оптимизировать код VBA
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Yaroslav_T,  смотрите #2 и не раздувайте из мухи слона. При таких объёмах это не столь влияет сколько пересчет, который запускается при каждом присвоении значения. Если конечно добиваться идеала, то конечно обращения к объекту надо переводить через загрузку в массив и выгрузку обратно в область.  
По вопросам из тем форума, личку не читаю.
 
Дмитрий Щербаков, у Вас замечательная статья по ссылке!
Есть одна маленькая неточность -
Цитата
'Отключаем разбиение на печатные страницы
Application.DisplayStatusBar = False
 
Цитата
Апострофф написал:
Есть одна маленькая неточность
спасибо, поправил. Видимо копи-паста сработала :)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
БМВ написал:
При таких объёмах это не столь влияет сколько пересчет, который запускается при каждом присвоении значения
Я говорил про идентификацию строчек / блока кода, на котором происходят наибольшие временные потери. Это строчки кода, где происходит обращение к ячейке на листе и запись в нее. А уже почему и как исправить - это уже вопрос

Ок - возможно формулировка в моем посте была не совсем точная, поправлю
 
ТСу, похоже, не интересно что Вы все тут ему насоветовали :) .
etrusk, приложите файл-пример
Согласие есть продукт при полном непротивлении сторон
Страницы: 1
Наверх