Помогите оптимизировать макрос / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите оптимизировать макрос

4 сообщений из 4, страница 1 из 1

Помогите оптимизировать макрос

#34898009

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:14:51

| Ответить | Цитировать | Написать

Помогите оптимизировать макрос

#34898027

Kvazimodo

Гость

Забыл написать - между синими строками не везде 4 строки (на картинке только часть файла), может быть и 2 может быть и 10, не известно заранее...

...

Рейтинг:

0 / 0

26.10.2007, 16:18:08

| Ответить | Цитировать | Написать

Помогите оптимизировать макрос

#34898134

big-duke

Участник

Сообщения: 6 245

Рейтинг: 0 / 0

Код: 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, 16:42:59

| Ответить | Цитировать | Написать

Помогите оптимизировать макрос

#34898363

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

26.10.2007, 17:36:32

| Ответить | Цитировать | Написать

4 сообщений из 4, страница 1 из 1

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите оптимизировать макрос

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&msg=34898009&tid=2182020]:	0ms
get settings:	10ms
get forum list:	18ms
check forum access:	3ms
check topic access:	3ms
track hit:	35ms
get topic data:	10ms
get forum data:	2ms
get page messages:	51ms
get tp. blocked users:	2ms
others:	229ms

total:	363ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы