Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Код работает медленно - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Код работает медленно (Макросы/Sub)
Код работает медленно
tasdel Дата: Суббота, 18.09.2021, 18:43 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 144
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Здравствуйте, уважаемые колдуны и шаманы!!!
Имеется простенький код, который туговато работает. Подскажите пожалуйста,как сделать так, чтобы он работал пошустрее? Самому мне не осилить.
Заранее спасибо!!!

[vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim isect As Variant
Dim rn As Range
Set rn = ActiveSheet.Range("D12:AH18")
Set isect = Application.Intersect(rn, Target)
If isect Is Nothing Then
Exit Sub
Else

On Error Resume Next

If ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-1, 0) = ActiveCell Then
ActiveCell.Offset(-1, 0) = ""
End If
End If

If ActiveCell.Offset(-2, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-2, 0) = ActiveCell Then
ActiveCell.Offset(-2, 0) = ""
End If
End If

If ActiveCell.Offset(-3, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-3, 0) = ActiveCell Then
ActiveCell.Offset(-3, 0) = ""
End If
End If
   
If ActiveCell.Offset(-4, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-4, 0) = ActiveCell Then
ActiveCell.Offset(-4, 0) = ""
End If
End If
  
If ActiveCell.Offset(-5, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-5, 0) = ActiveCell Then
ActiveCell.Offset(-5, 0) = ""
End If
End If
   
If ActiveCell.Offset(-6, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-6, 0) = ActiveCell Then
ActiveCell.Offset(-6, 0) = ""
End If
End If

If ActiveCell.Offset(1, 0) = ActiveCell Then
ActiveCell.Offset(1, 0) = ""
End If

If ActiveCell.Offset(2, 0) = ActiveCell Then
ActiveCell.Offset(2, 0) = ""
End If

If ActiveCell.Offset(3, 0) = ActiveCell Then
ActiveCell.Offset(3, 0) = ""
End If

If ActiveCell.Offset(4, 0) = ActiveCell Then
ActiveCell.Offset(4, 0) = ""
End If

If ActiveCell.Offset(5, 0) = ActiveCell Then
ActiveCell.Offset(5, 0) = ""
End If

If ActiveCell.Offset(6, 0) = ActiveCell Then
ActiveCell.Offset(6, 0) = ""
End If

   
End If
End Sub
[/vba]
 
Ответить
СообщениеЗдравствуйте, уважаемые колдуны и шаманы!!!
Имеется простенький код, который туговато работает. Подскажите пожалуйста,как сделать так, чтобы он работал пошустрее? Самому мне не осилить.
Заранее спасибо!!!

[vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim isect As Variant
Dim rn As Range
Set rn = ActiveSheet.Range("D12:AH18")
Set isect = Application.Intersect(rn, Target)
If isect Is Nothing Then
Exit Sub
Else

On Error Resume Next

If ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-1, 0) = ActiveCell Then
ActiveCell.Offset(-1, 0) = ""
End If
End If

If ActiveCell.Offset(-2, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-2, 0) = ActiveCell Then
ActiveCell.Offset(-2, 0) = ""
End If
End If

If ActiveCell.Offset(-3, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-3, 0) = ActiveCell Then
ActiveCell.Offset(-3, 0) = ""
End If
End If
   
If ActiveCell.Offset(-4, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-4, 0) = ActiveCell Then
ActiveCell.Offset(-4, 0) = ""
End If
End If
  
If ActiveCell.Offset(-5, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-5, 0) = ActiveCell Then
ActiveCell.Offset(-5, 0) = ""
End If
End If
   
If ActiveCell.Offset(-6, 0).Interior.ColorIndex = xlNone Then
If ActiveCell.Offset(-6, 0) = ActiveCell Then
ActiveCell.Offset(-6, 0) = ""
End If
End If

If ActiveCell.Offset(1, 0) = ActiveCell Then
ActiveCell.Offset(1, 0) = ""
End If

If ActiveCell.Offset(2, 0) = ActiveCell Then
ActiveCell.Offset(2, 0) = ""
End If

If ActiveCell.Offset(3, 0) = ActiveCell Then
ActiveCell.Offset(3, 0) = ""
End If

If ActiveCell.Offset(4, 0) = ActiveCell Then
ActiveCell.Offset(4, 0) = ""
End If

If ActiveCell.Offset(5, 0) = ActiveCell Then
ActiveCell.Offset(5, 0) = ""
End If

If ActiveCell.Offset(6, 0) = ActiveCell Then
ActiveCell.Offset(6, 0) = ""
End If

   
End If
End Sub
[/vba]
Автор - tasdel
Дата добавления - 18.09.2021 в 18:43
wild_pig Дата: Воскресенье, 19.09.2021, 01:31 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 518
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Отключать / включать прорисовку экрана
 
Ответить
СообщениеОтключать / включать прорисовку экрана
Автор - wild_pig
Дата добавления - 19.09.2021 в 01:31
Апострофф Дата: Воскресенье, 19.09.2021, 02:44 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
И поменять порядок запросов для начала надо. Сначала сравнить значение, потом цвет ячеек пытать. А потом можно и цыклы пристегнуть. Скорости это не добавит, но код станет удобоваримее.
 
Ответить
СообщениеИ поменять порядок запросов для начала надо. Сначала сравнить значение, потом цвет ячеек пытать. А потом можно и цыклы пристегнуть. Скорости это не добавит, но код станет удобоваримее.
Автор - Апострофф
Дата добавления - 19.09.2021 в 02:44
tasdel Дата: Воскресенье, 19.09.2021, 11:18 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 144
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
wild_pig, Делал, не помогает, еще хуже работает.


Сообщение отредактировал tasdel - Воскресенье, 19.09.2021, 11:31
 
Ответить
Сообщениеwild_pig, Делал, не помогает, еще хуже работает.
Автор - tasdel
Дата добавления - 19.09.2021 в 11:18
tasdel Дата: Воскресенье, 19.09.2021, 11:21 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 144
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Цитата
И поменять порядок запросов для начала надо. Сначала сравнить значение, потом цвет ячеек пытать. А потом можно и цыклы пристегнуть. Скорости это не добавит, но код станет удобоваримее.

Апострофф, Вы мне так говорите, как- будто я профессионал.


Сообщение отредактировал tasdel - Воскресенье, 19.09.2021, 11:22
 
Ответить
Сообщение
Цитата
И поменять порядок запросов для начала надо. Сначала сравнить значение, потом цвет ячеек пытать. А потом можно и цыклы пристегнуть. Скорости это не добавит, но код станет удобоваримее.

Апострофф, Вы мне так говорите, как- будто я профессионал.
Автор - tasdel
Дата добавления - 19.09.2021 в 11:21
MikeVol Дата: Воскресенье, 19.09.2021, 14:48 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 378
Репутация: 81 ±
Замечаний: 0% ±

MSO LTSC 2021 EN
tasdel, поменяйте местами строки там где есть Interior.ColorIndex = xlNone Then с ActiveCell Then
Вот на что намекнул Апострофф.

Ученик.
Одесса - Украина
 
Ответить
Сообщениеtasdel, поменяйте местами строки там где есть Interior.ColorIndex = xlNone Then с ActiveCell Then
Вот на что намекнул Апострофф.
Автор - MikeVol
Дата добавления - 19.09.2021 в 14:48
tasdel Дата: Воскресенье, 19.09.2021, 15:24 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 144
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
MikeVol, Поменял, особых изменений не наблюдается.
 
Ответить
СообщениеMikeVol, Поменял, особых изменений не наблюдается.
Автор - tasdel
Дата добавления - 19.09.2021 в 15:24
tasdel Дата: Воскресенье, 19.09.2021, 15:40 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 144
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Решил проблему, ребята. Сделал выход из процедуры, если выделяется пустая активная ячейка.
 
Ответить
СообщениеРешил проблему, ребята. Сделал выход из процедуры, если выделяется пустая активная ячейка.
Автор - tasdel
Дата добавления - 19.09.2021 в 15:40
tasdel Дата: Воскресенье, 19.09.2021, 18:34 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 144
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
wild_pig, Вы не могли бы поправить код, чтобы он срабатывал отдельно на каждый выбранный мною диапазон. У меня бывают таблицы, которые я разделяю на множество диапазонов.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect As Variant
Dim rn As Range
Set rn = Range("D19:AH19")
Set isect = Application.Intersect(rn, Target)
If isect Is Nothing Then
Exit Sub
Else
Call ЗАЛИВКА
End If
End Sub
[/vba]


Сообщение отредактировал tasdel - Воскресенье, 19.09.2021, 18:37
 
Ответить
Сообщениеwild_pig, Вы не могли бы поправить код, чтобы он срабатывал отдельно на каждый выбранный мною диапазон. У меня бывают таблицы, которые я разделяю на множество диапазонов.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect As Variant
Dim rn As Range
Set rn = Range("D19:AH19")
Set isect = Application.Intersect(rn, Target)
If isect Is Nothing Then
Exit Sub
Else
Call ЗАЛИВКА
End If
End Sub
[/vba]
Автор - tasdel
Дата добавления - 19.09.2021 в 18:34
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Код работает медленно (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!