Добрый день уважаемые форумчане. Прошу помощи знатоков по оптимизации кода функций 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
Думаю что пример не нужен но следуя правилам прикрепил его.
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
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