Exel Изменение цвета строки при заполнении ячейки

[молекула]

Подскажите пожалуйста! Есть список счетов, часть оплачена, часть нет. Как сделать чтоб при заполненной ячейке "оплата" вся строка меняла цвет (в ячейке пишется номер счета, где оплачен и разные поправки, текст зачастую разный, поэтому поставить условное форматирование на слово "оплачено" не получится. )

[Константин_50]

Можно написать пару строк на VBA в обработчике события листа Worksheet_Change.

[Аноним]

Можно написать пару строк на VBA в обработчике события листа Worksheet_Change.

Пожалуйста поподробнее

[Константин_50]

Сохраняете Вашу книгу в формате xlsm, в модуле нужного листа размещаете следующий код

Private Sub Worksheet_Change(ByVal Target As Range)
‘ здесь делаете все, что пожелаете
End Sub

Этот код будет исполняться при каждом ручном изменении данных на листе.

[vikttur]

Чтобы код не срабатывал при любых изменениях на листе, необходимо добавить диапазон, на который будет реагировать макрос (в Вашем случае - столбец с ячейками "оплата"):

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub ' выход, если выделено более одной ячейки
    If Not Intersect(Target, Range("A1:A100")) Is Nothing Then ' если изменение в диапазоне, код работает
    ..................................
    End If
End Sub

...текст зачастую разный, поэтому поставить условное форматирование на слово "оплачено" не получится. )

В УФ можно определять не само слово, на наличие значения (текста):

=ДЛСТР(A1)>1
=ЕТЕКСТ(A1)
=A1<>""
=A1<>0

[Константин_50]

Тогда и я своим примером поделюсь.
После размещения этого маленького кода в модуле листа

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Range
    If Not Intersect(Target, Me.Columns(1)) Is Nothing Then
        If Intersect(Target, Me.Columns(1)).Cells.Count < 100 Then
            For Each R In Intersect(Target, Me.Columns(1))
                If Not IsEmpty(R.Value) Then
                    R.EntireRow.Font.Color = RGB(255, 0, 0)
                Else
                    R.EntireRow.Font.ColorIndex = xlAutomatic
                End If
            Next
        End If
    End If
End Sub 

будет происходить следующее. (Тэг PHP-код читать как VBA-код).
При заполнении ячеек первой колонки любыми значениями, отличными от пустых - цвет шрифта в строках будет становиться «красненьким». При очистке содержимого ячеек (кнопкой Del или через контекстное меню) первой колонки – цвет шрифта этих строках будет возвращаться в цвет по умолчанию. Первую колонку можно заполнять вручную, копированием через буфер обмена и т.д. Кол-во одновременно измененных ячеек не должно превышать 100.

[молекула]

Тогда и я своим примером поделюсь.
После размещения этого маленького кода в модуле листа

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Range
    If Not Intersect(Target, Me.Columns(1)) Is Nothing Then
        If Intersect(Target, Me.Columns(1)).Cells.Count < 100 Then
            For Each R In Intersect(Target, Me.Columns(1))
                If Not IsEmpty(R.Value) Then
                    R.EntireRow.Font.Color = RGB(255, 0, 0)
                Else
                    R.EntireRow.Font.ColorIndex = xlAutomatic
                End If
            Next
        End If
    End If
End Sub 

Да, то что я хотела, спасибо!

[Константин_50]

Не за что, обращайтесь.

[Аноним]

А как изменить выделение текста красным цветом на заливку ячеек?

[Константин_50]

Например, так:
заменить 7-ю строчку на R.EntireRow.Interior.Color = RGB(255, 0, 0),
соответственно 9-ю строчку на R.EntireRow.Interior.Pattern = xlNone

[Аноним]

Доброго время суток.
очень заинтересовал этот макрос.
У меня такой вопрос. А можно сделать так, что при вводе в первый столбец цвет строки красный,
а при вводе во второй цвет строки меняется на синий?

[vikttur]

Код разместить в модуле листа:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub ' выход, если выделено более одной ячейки
    If Not Intersect(Target, Range("A1:B100")) Is Nothing Then '  диапазон реагирования кода
        With Target
            If .Value = Empty Then ' если значения нет (ячейку очистили)
                Rows(.Row).Interior.Pattern = xlNone ' убираем цвет строки
                Exit Sub ' выход из процедуры
            End If
                
            Select Case .Column
                Case 1 ' если столбец первый
                    Range(Cells(.Row, 1), Cells(.Row, 4)).Interior.ColorIndex = 3 ' красим диапазон
'                    Rows(.Row).Interior.ColorIndex = 3 ' красим строку
                Case 2 ' если столбец второй
                    Rows(.Row).Interior.ColorIndex = 5 ' красим строку
            End Select
        End With
    End If
End Sub

Если цвет строки убирать не нужно, закомментируйте строку (апостроф в начале строки).
При изменении значений первого столбца для примера сделана заливка не строки, а диапазона.

Для выбора цвета можно запустить небольшой макрос. Код закрасит 55 ячеек третьего столбца палитрой цветов. Номер цвета в палитре - номер его строки.

' заливка ячеек на активном листе (в столбце3)
Sub ColorCells()
Dim i As Long
    For i = 1 To 55
        Cells(i, 3).Interior.ColorIndex = i
    Next i
End Sub

Код разместить в общем модуле.

Число в строке макроса модуля листа и есть номер цвета: .Interior.ColorIndex = 5