Страницы: 1
RSS
Упростить повторяющуюся функцию If Then Else для нескольких ячеек, Помощь в оптимизации кода
 
Добрый день уважаемые форумчане. Прошу помощи знатоков по оптимизации кода функций If Then Else, применяемые для сравнения величины в ячейках В37:I39, и если значение в какой либо ячейке из диапазона (В37:I39) больше чем в ячейке D32 то шрифт в ячейках(В37:I39), которые превысили значение, меняется на красные, если нет то черный.
Собственно сам код:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(37, 4).Value >= Cells(33, 4).Value Then _
    Cells(37, 4).Font.Color = vbRed Else Cells(37, 4).Font.Color = vbBlack
If Cells(38, 4).Value >= Cells(33, 4).Value Then _
    Cells(38, 4).Font.Color = vbRed Else Cells(38, 4).Font.Color = vbBlack
If Cells(39, 4).Value >= Cells(33, 4).Value Then _
    Cells(39, 4).Font.Color = vbRed Else Cells(39, 4).Font.Color = vbBlack
If Cells(37, 5).Value >= Cells(33, 4).Value Then _
    Cells(37, 5).Font.Color = vbRed Else Cells(37, 5).Font.Color = vbBlack
If Cells(38, 5).Value >= Cells(33, 4).Value Then _
    Cells(38, 5).Font.Color = vbRed Else Cells(38, 5).Font.Color = vbBlack
If Cells(39, 5).Value >= Cells(33, 4).Value Then _
    Cells(39, 5).Font.Color = vbRed Else Cells(39, 5).Font.Color = vbBlack
If Cells(37, 6).Value >= Cells(33, 4).Value Then _
    Cells(37, 6).Font.Color = vbRed Else Cells(37, 6).Font.Color = vbBlack
If Cells(38, 6).Value >= Cells(33, 4).Value Then _
    Cells(38, 6).Font.Color = vbRed Else Cells(38, 6).Font.Color = vbBlack
If Cells(39, 6).Value >= Cells(33, 4).Value Then _
    Cells(39, 6).Font.Color = vbRed Else Cells(39, 6).Font.Color = vbBlack
If Cells(37, 7).Value >= Cells(33, 4).Value Then _
    Cells(37, 7).Font.Color = vbRed Else Cells(37, 7).Font.Color = vbBlack
If Cells(38, 7).Value >= Cells(33, 4).Value Then _
    Cells(38, 7).Font.Color = vbRed Else Cells(38, 7).Font.Color = vbBlack
If Cells(39, 7).Value >= Cells(33, 4).Value Then _
    Cells(39, 7).Font.Color = vbRed Else Cells(39, 7).Font.Color = vbBlack
If Cells(37, 8).Value >= Cells(33, 4).Value Then _
    Cells(37, 8).Font.Color = vbRed Else Cells(37, 8).Font.Color = vbBlack
If Cells(38, 8).Value >= Cells(33, 4).Value Then _
    Cells(38, 8).Font.Color = vbRed Else Cells(38, 8).Font.Color = vbBlack
If Cells(39, 8).Value >= Cells(33, 4).Value Then _
    Cells(39, 8).Font.Color = vbRed Else Cells(39, 8).Font.Color = vbBlack
If Cells(37, 9).Value >= Cells(33, 4).Value Then _
    Cells(37, 9).Font.Color = vbRed Else Cells(37, 9).Font.Color = vbBlack
If Cells(38, 9).Value >= Cells(33, 4).Value Then _
    Cells(38, 9).Font.Color = vbRed Else Cells(38, 9).Font.Color = vbBlack
If Cells(39, 9).Value >= Cells(33, 4).Value Then _
    Cells(39, 9).Font.Color = vbRed Else Cells(39, 9).Font.Color = vbBlack
End Sub


Думаю что пример не нужен но следуя правилам прикрепил его.

С Уважением,
Роман
Изменено: crysi - 30.03.2018 16:27:18
 

Код
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cl In Range("B37:I39")
  If cl >= [d32].Value Then _
    cl.Font.Color = vbRed Else cl.Font.Color = vbBlack
Next
End Sub
Изменено: yozhik - 30.03.2018 16:41:44
 
crysi, а почему не использовать условное форматирование?
 
StepanWolkoff, ну может по причине того что начинает файл подтормаживать..
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
StepanWolkoff написал:
crysi , а почему не использовать условное форматирование?
Дело в том, что файлик дальше будет сохранятся с удалением всех связей и формул, для хранения на сервере и предоставления End Users, задача в том чтоб бланк был как можно легче, я возможно не прав но условное форматирование будет сохранятся с новым листом так же. если нет поправьте пожалуйста.

yozhik, спасибо большое, сейчас проверю, и отпишусь.
 
упростите так:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r&
  For r = 37 To 39
    If Cells(r, 4) >= Cells(33, 4) Then Cells(r, 4).Font.Color = vbRed Else Cells(r, 4).Resize(1, 6).Font.Color = vbBlack
  Next
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
yozhik, я может, что то не так делаю но Ваш код меняет цвет шрифта во всех ячейки из диапазона, суть в том чтоб цвет шрифта менялся в той ячейке которая превышают сравниваемое значение.
в своем листе я указал так:
Код
Dim cl As Range
For Each cl In Range("B37:I39")
  If cl >= [d32].Value Then _
    cl.Font.Color = vbRed Else cl.Font.Color = vbBlack
Next


Спасибо.
Изменено: crysi - 30.03.2018 16:54:54
 
В код от yozhik, вкралась опечатка
Код
Dim cl As Range
For Each cl In Range("D37:I39")
  If cl >= [d33].Value Then _
    cl.Font.Color = vbRed Else cl.Font.Color = vbBlack
Next
Изменено: Sanja - 30.03.2018 17:01:33
Согласие есть продукт при полном непротивлении сторон
 
Лазить в цикле по многу раз в [d32] - это потеря времени. Извлеките значение в переменную и сравнивайте с переменной.
 
Hugo, уже понял исходя из примеров, спасибо.
Ігор Гончаренко, спасибо за ваш пример, работает.
Sanja, спасибо, работает как надо!

Вопрос можно закрывать
Изменено: crysi - 30.03.2018 18:15:57
 
Sanja, спасибо)
Страницы: 1
Наверх