Страницы: 1
RSS
VBA: форматирование при большем или меньше числе в ячейке, как?
 
Добрый день.
Очень надеюсь, что оформлю тему как положено.

У меня есть VBA макрос, который при любом изменении в указанном диапазоне ячеек окрашивает в зеленый текст.
Не принципиально, будь то цифры или текст
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vValue
If Not Intersect(Target, [A1:A10]) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target <> vValue Then Target.Font.Color = RGB(107, 164, 41)
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
End Sub
Вопрос и просьба в следующем.
Я данный макрос использую в таблице в которой вношу отметки о количестве сделанного, очень удобно, всегда видно где новое, где старое, но не суть.

Как научить этот макрос реагировать только на вводимые цифры и как сделать чтобы допустим ввожу цифру 5, она краситься в указанный в макросе цвет, ввожу  цифру меньшего значения, допустим 4 и она красилась бы в другой цвет?
Изменено: Абитуриент - 18.05.2022 16:57:19
 
Абитуриент, добрый день! Можно добавить условий в Ваш код:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vValue
If Not Intersect(Target, [A1:A10]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    Debug.Print TypeName(Target.Value) ' узнаем тип данных в активной ячейке
    If TypeName(Target.Value) = "Double" And Target.Value = 5 Then
        Target.Font.Color = vbRed
    ElseIf TypeName(Target.Value) = "Double" And Target.Value < 5 Then
        Target.Font.Color = vbGreen
    ElseIf TypeName(Target.Value) = "String" Then
        Target.Font.Color = vbBlue
    End If
End If
End Sub
 
Спасибо за пример.
Как я понимаю в данный момент все цифры от 5 и выше красятся в красный цвет, а все цифры ниже 5 в зеленый, верно я понял? А как сделать более универсальнее? Допустим в ячейке А1: написали 2 покрасилось в красный, затем в той же ячейке А1 пишем 1 и она уже стала зеленой. Или я чего-то не заметил из-за своей не опытности?
Изменено: Абитуриент - 18.05.2022 17:45:58
 
Просто измените условие. Сейчас, к сожалению не могу код написать, не у компьютера
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vValue
    If Not Intersect(Target, [A1:A10]) Is Nothing Then 'указываем диапазон где нужно работать
        If Target.Count > 1 Then Exit Sub ' если меняем больше одной, то выход
        If Target = "" Then Exit Sub ' если пусто
        Application.EnableEvents = 0
        Application.Undo ' Откат операции
        vValue = Target.Value ' какое там значение раньше было
        Application.Undo ' Обратный откат
        If Target <> vValue Then ' если значение изменилось
            If Target > vValue Then ' если значение изменилось
                Target.Font.Color = RGB(107, 164, 41) 'окрашиваем новые изменения в зеленый цвет
            Else
                Target.Font.Color = RGB(207, 164, 41)
            End If
        End If
        Application.EnableEvents = 1
    End If
End Sub
Скажи мне, кудесник, любимец ба’гов...
 
Цитата
написал:
все цифры от 5 и выше красятся в красный цвет, а все цифры ниже 5 в зеленый
да, верно.
Цитата
написал:
в той же ячейке А1 пишем 1 и она уже стала зеленой
просто замените 5 на 2
 
_Boroda_, спасибо огромное
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vValue
    If Not Intersect(Target, [A1:A10]) Is Nothing Then 'указываем диапазон где нужно работать
        If Target.Count > 1 Then Exit Sub ' если меняем больше одной, то выход
        If Target = "" Then Exit Sub ' если пусто
        Application.EnableEvents = 0
        Application.Undo ' Откат операции
        vValue = Target.Value ' какое там значение раньше было
        Application.Undo ' Обратный откат
        If Target <> vValue Then ' если значение изменилось
            If Target > vValue Then ' если значение изменилось
                Target.Font.Color = RGB(107, 164, 41) 'окрашиваем новые изменения в зеленый цвет
            Else
                Target.Font.Color = RGB(207, 164, 41)
            End If
        End If
        Application.EnableEvents = 1
    End If
End Sub

Из обнаруженного. Если выделить весь лист целиков и нажать делит на клавиатуре, чтобы очистить лист появляется окно с ошибкой "Run-time error: '6': Overflow" как побороть?
Изменено: Абитуриент - 18.05.2022 19:54:13
 
боритесь так:
вместо
If Target.Count > 1 Then Exit Sub ' если меняем больше одной, то выход
пишите
If Target.CountLarge > 1 Then Exit Sub ' если меняем больше одной, то выход

и на следующий раз будете спрашивать об ошибке, пишите не только код ошибки и текст сообщения, а еще и строку кода, в которой это произошло
не всем интересно пучить глаза в код, искать "а где же это могло случиться?"
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Спасибо  :oops:  
Страницы: 1
Наверх