Тема от Alex.spb (изменено: Alex.spb, 16 января 2008г. 16:07:23)

  • Откуда: :зИ
  • На форуме с 21 мая 2007г.
  • Сообщений: 73
  • Спасибо: 0

Тема: Оптимизация скрипта раскраски

При использовании скрипта раскраски наблюдаются неприятные "тормоза" при обращении к родительскому объекты. Подскажите, как следует оптимизировать скрипт, чтобы отображение объекта с 300-600 вложенными объектами не подвисало во время раскраски?

Sub GoColoured(Sheet)
       For i=0 to Sheet.Objects.Count-1
          Set ShRow = Sheet.Objects.Item(i)
          if ShRow.Attributes.Has("A_High_Priority") then
              if ShRow.Attributes("A_High_Priority").Value then
                 Sheet.RowFormat(i).BackColor = &H00FFC97F&  
              end if
              if ShRow.Roles.Has("ROLE_Controlling") then Sheet.RowFormat(i).Color = &H000000BB&
          end if
      Next    
  End Sub

  • SSV
  • Участник
  • Откуда: Nizhny Novgorod
  • На форуме с 26 июля 2007г.
  • Сообщений: 60
  • Спасибо: 0

Re: Оптимизация скрипта раскраски

В каждой итерации цикла вычисляется Sheet.Objects.Count
Попробуйте так:

Sub GoColoured(Sheet)
       '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       Dim cnt
       cnt = Sheet.Objects.Count-1
       For i=0 to cnt
       ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
          Set ShRow = Sheet.Objects.Item(i)
          if ShRow.Attributes.Has("A_High_Priority") then
              if ShRow.Attributes("A_High_Priority").Value then
                 Sheet.RowFormat(i).BackColor = &H00FFC97F&  
              end if
              if ShRow.Roles.Has("ROLE_Controlling") then Sheet.RowFormat(i).Color = &H000000BB&
          end if
      Next    
  End Sub

  • Откуда: :зИ
  • На форуме с 21 мая 2007г.
  • Сообщений: 73
  • Спасибо: 0

Re: Оптимизация скрипта раскраски

В каждой итерации цикла вычисляется Sheet.Objects.Count

Вы уверены в этом? По идее не должно быть такого, но я попробую, спасибо.

  • Откуда: Город Пафосный
  • На форуме с 15 марта 2007г.
  • Сообщений: 279
  • Спасибо: 0

Re: Оптимизация скрипта раскраски

https://tdmsforum.ru/topic30.html
см. ответ от  07.04.2007, 13:09 

Set ShRow = Sheet.Objects.Item(i) - эта строка тормозит всё и вся.  - в каждой итерации пересчитывается коллекция объектов.

если я не ошибаюсь, count в первом постинге тормозить не будет.

Ответ от Alex.spb (изменено: Alex.spb, 18 января 2008г. 11:43:23)

  • Откуда: :зИ
  • На форуме с 21 мая 2007г.
  • Сообщений: 73
  • Спасибо: 0

Re: Оптимизация скрипта раскраски

1. Чтобы не проверять наличие атрибута, выключил обработку ошибок.
2. Убрал цикл for..next

on error resume next
i = 0
for each obj in Sheet.Objects
    if obj.Attributes("A_High_Priority").Value then Sheet.RowFormat(i).BackColor = &H00FFC97F&  
    if obj.Roles.Has("ROLE_Controlling") then Sheet.RowFormat(i).Color = &H000000BB&
    i = i + 1
Next

Уважаемые перфекционисты, предел совершенства в данном контексте достигнут?

  • Откуда: Воронеж
  • На форуме с 17 марта 2007г.
  • Сообщений: 341
  • Спасибо: 0

Re: Оптимизация скрипта раскраски

Мой "параноидальный" метод  :)

Sub GoColoured(Sheet)
       Set Objs = Sheet.Objects
       Cnt = Objs.Count
       For i=0 to Cnt-1
          Set ShRow = Objs(i)
          Set Attrs = ShRow.Attributes
          if Attrs.Has("A_High_Priority") then
              Set RowFormats = Sheet.RowFormat
              if Attrs("A_High_Priority").Value then
                 RowFormats(i).BackColor = &H00FFC97F&  
              end if
              if ShRow.Roles.Has("ROLE_Controlling") then RowFormats(i).Color = &H000000BB&
              Set RowFormats = Nothing
          end if
          Set Attrs = Nothing
          Set ShRow = Nothing
      Next    
      Set Objs = Nothing
  End Sub

Как-то так  :)