Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите оптимизировать макрос / 4 сообщений из 4, страница 1 из 1
26.10.2007, 16:14:51
    #34898009
Kvazimodo
Kvazimodo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите оптимизировать макрос
Есть табличка как на картинке. Она заполняется данными и периодически их надо убивать на прочь в области с 3 по 8 столбец и с 12 по последнюю ячейку с данными за исключением синих строк (их не надо трогать). Написал следующее (при тычке на кнопке)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
    ' поиск первой пустой ячейки
    r =  12 
    While Sheets("Массы").Range("a" + LTrim(Str(r))) <> Empty
    r = r +  1 
    Wend
    ' очистка рабочей области
    For i =  13  To r -  5 
    For j =  3  To  8 
    If Cells(i, j).Interior.ColorIndex <>  41  Then Cells(i, j).ClearContents
    Next j
    Next i
Все в принципе работает, только табличка подрастает время от времени и скорость обработки кода соответственно увеличивается (сейчас на очень приличной машине обработка такого кода с приведенной страницей занимает около минуты времени). Честно, долго думал, как его можно по другому переписать но знаний в VBA не хватает. Можно выделить весь очищаемый диапазон, но мне нельзя очищать синие строки иначе в каждой нужно восстанавливать формулы. Кароче - затык произошел :) поможите кто может... пожалста
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2007, 16:18:08
    #34898027
Kvazimodo
Kvazimodo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите оптимизировать макрос
Забыл написать - между синими строками не везде 4 строки (на картинке только часть файла), может быть и 2 может быть и 10, не известно заранее...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2007, 16:42:59
    #34898134
big-duke
big-duke
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите оптимизировать макрос
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Public Sub CustomClear()
    Dim L As Long
    Dim R As Range
    Dim TargetRange As Range
    Application.ScreenUpdating = False
    L = LastUsedRow
    Set TargetRange = Range("A12:A" & L)
    For Each R In TargetRange
        If R.Interior.ColorIndex <>  41  Then
            Range(R.Offset(,  2 ), R.Offset(,  7 )).ClearContents
        End If
    Next R
    Application.ScreenUpdating = True
    
    
End Sub
Public Function LastUsedRow() As Long
Dim tmpR As Range
Dim arRow( 256 ) As Long
   For Each tmpR In [A65536:AA65536]
       arRow(tmpR.Column) = tmpR.End(xlUp).Row
   Next

   LastUsedRow = WorksheetFunction.Max(arRow)

End Function
10 000 строк обрабатываются около 7 сек. Celeron 2.8 GHz.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2007, 17:36:32
    #34898363
Kvazimodo
Kvazimodo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите оптимизировать макрос
Спасиба за оперитивность :-) написал так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Dim TargetRange As Range
...
Application.ScreenUpdating = False
    r =  12 
    While Sheets("Массы").Range("a" + LTrim(Str(r))) <> Empty
    r = r +  1 
    Wend
    Set TargetRange = Range("A12:A" & r -  5 )
    For Each r In TargetRange
        If r.Interior.ColorIndex <>  41  Then
            Range(r.Offset(,  2 ), r.Offset(,  7 )).ClearContents
        End If
    Next r
...
Я не очень понимаю как это работает (не понятна строка с если), но если не ошибаюсь, суть не поменялась, здесь, то же простой последовательный перебор ячеек и проверка на цвет.
Однако скорость реально возрасла с 35 до 5 секунд и это радует...
А если мне можно сузить диапазон и очищать не со столбца "А" а с "С", для этого нужно строку
Код: plaintext
Set TargetRange = Range("A12:A" & r -  5 )
изменить на
Код: plaintext
Set TargetRange = Range("С12:С" & r -  5 )
? или офсеты дальше тоже менять придется?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите оптимизировать макрос / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 295ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2182020]:
 0ms
get settings:
 7ms
get forum list:
 13ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 42ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 32ms
get tp. blocked users:
 1ms
others: 187ms
total:  295ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]