Vba excel закрасить строку - Word и Excel - помощь в работе с программами

Заливка ячейки цветом в VBA Excel. Фон ячейки. Свойства .Interior.Color и .Interior.ColorIndex. Цветовая модель RGB. Стандартная палитра. Очистка фона ячейки.

Свойство .Interior.Color объекта Range

Начиная с Excel 2007 основным способом заливки диапазона или отдельной ячейки цветом (зарисовки, добавления, изменения фона) является использование свойства .Interior.Color объекта Range путем присваивания ему значения цвета в виде десятичного числа от 0 до 16777215 (всего 16777216 цветов).

Заливка ячейки цветом в VBA Excel

Пример кода 1:

Sub ColorTest1()

Range(«A1»).Interior.Color = 31569

Range(«A4:D8»).Interior.Color = 4569325

Range(«C12:D17»).Cells(4).Interior.Color = 568569

Cells(3, 6).Interior.Color = 12659

End Sub

Поместите пример кода в свой программный модуль и нажмите кнопку на панели инструментов «Run Sub» или на клавиатуре «F5», курсор должен быть внутри выполняемой программы. На активном листе Excel ячейки и диапазон, выбранные в коде, окрасятся в соответствующие цвета.

Есть один интересный нюанс: если присвоить свойству .Interior.Color отрицательное значение от -16777215 до -1, то цвет будет соответствовать значению, равному сумме максимального значения палитры (16777215) и присвоенного отрицательного значения. Например, заливка всех трех ячеек после выполнения следующего кода будет одинакова:

Sub ColorTest11()

Cells(1, 1).Interior.Color = —12207890

Cells(2, 1).Interior.Color = 16777215 + (—12207890)

Cells(3, 1).Interior.Color = 4569325

End Sub

Проверено в Excel 2016.

Вывод сообщений о числовых значениях цветов

Числовые значения цветов запомнить невозможно, поэтому часто возникает вопрос о том, как узнать числовое значение фона ячейки. Следующий код VBA Excel выводит сообщения о числовых значениях присвоенных ранее цветов.

Пример кода 2:

Sub ColorTest2()

MsgBox Range(«A1»).Interior.Color

MsgBox Range(«A4:D8»).Interior.Color

MsgBox Range(«C12:D17»).Cells(4).Interior.Color

MsgBox Cells(3, 6).Interior.Color

End Sub

Вместо вывода сообщений можно присвоить числовые значения цветов переменным, объявив их как Long.

Использование предопределенных констант

В VBA Excel есть предопределенные константы часто используемых цветов для заливки ячеек:

Предопределенная константа	Наименование цвета
vbBlack	Черный
vbBlue	Голубой
vbCyan	Бирюзовый
vbGreen	Зеленый
vbMagenta	Пурпурный
vbRed	Красный
vbWhite	Белый
vbYellow	Желтый
xlNone	Нет заливки

Присваивается цвет ячейке предопределенной константой в VBA Excel точно так же, как и числовым значением:

Пример кода 3:

Range(«A1»).Interior.Color = vbGreen

Цветовая модель RGB

Цветовая система RGB представляет собой комбинацию различных по интенсивности основных трех цветов: красного, зеленого и синего. Они могут принимать значения от 0 до 255. Если все значения равны 0 — это черный цвет, если все значения равны 255 — это белый цвет.

Выбрать цвет и узнать его значения RGB можно с помощью палитры Excel:

Палитра Excel

Чтобы можно было присвоить ячейке или диапазону цвет с помощью значений RGB, их необходимо перевести в десятичное число, обозначающее цвет. Для этого существует функция VBA Excel, которая так и называется — RGB.

Пример кода 4:

Range(«A1»).Interior.Color = RGB(100, 150, 200)

Список стандартных цветов с RGB-кодами смотрите в статье: HTML. Коды и названия цветов.

Очистка ячейки (диапазона) от заливки

Для очистки ячейки (диапазона) от заливки используется константа xlNone:

Range(«A1»).Interior.Color = xlNone

Свойство .Interior.ColorIndex объекта Range

До появления Excel 2007 существовала только ограниченная палитра для заливки ячеек фоном, состоявшая из 56 цветов, которая сохранилась и в настоящее время. Каждому цвету в этой палитре присвоен индекс от 1 до 56. Присвоить цвет ячейке по индексу или вывести сообщение о нем можно с помощью свойства .Interior.ColorIndex:

Пример кода 5:

Range(«A1»).Interior.ColorIndex = 8

MsgBox Range(«A1»).Interior.ColorIndex

Просмотреть ограниченную палитру для заливки ячеек фоном можно, запустив в VBA Excel простейший макрос:

Пример кода 6:

Sub ColorIndex()

Dim i As Byte

For i = 1 To 56

Cells(i, 1).Interior.ColorIndex = i

End Sub

Номера строк активного листа от 1 до 56 будут соответствовать индексу цвета, а ячейка в первом столбце будет залита соответствующим индексу фоном.

Подробнее о стандартной палитре Excel смотрите в статье: Стандартная палитра из 56 цветов, а также о том, как добавить узор в ячейку.

Источник

У Вас лишняя буква r прицепилась

.Interior.Color = vbRed 
.Interior.Color = RGB(255, 0, 0)
.Interior.Color = 255

Работа с объектами листа медленная. Если ячеек много и заливать нужно не целым диапазоном, можно обработать в памяти и залить ячейки одной командой.

     Sub PaintCells()
            Dim r1 As Range, r2 As Range
            Dim c As Range
                Set r1 = Range("A1:C10") ' диапазон в переменную
                r1.Interior.Pattern = xlNone ' убираем заливку
'               r1.Interior.ColorIndex = 0 ' или так 

                For Each c In r1 ' цикл по ячейкам диапазона
                    If c.Value = 25 Then ' если условие выполняется
                        If r2 Is Nothing Then '  диапазон еще пустой
                            Set r2 = c ' формируем диапазон
                        Else
                            Set r2 = Union(r2, c) ' пополняем диапазон
                        End If
                    End If
                Next c

                If Not r2 Is Nothing Then r2.Interior.Color = 255 ' заливаем
                Set r1 = Nothing: Set r2 = Nothing ' освобождаем память
            End Sub

Залить строки по условию в ячейке:

For i = 1 To r1.Rows.Count ' цикл по строкам диапазона
    If r1(i, 1).Value = 25 Then ' если левая ячейка диапазона...
        If r2 Is Nothing Then '  диапазон еще пустой
            Set r2 = Range(Cells(i, 1), Cells(i, 3)) ' формируем диапазон
        Else
            Set r2 = Union(r2, Range(Cells(i, 1), Cells(i, 3))) ' пополняем диапазон
        End If
    End If
Next i

Источник

Sub FindAndSelect()
 
Dim Rng As Range
Dim n
    With Worksheets("general_report")
        Set Rng = .Range("A2:G100")
        For Each n In Rng
            Select Case n
                Case "WAIT FOR RELEASE"
                    n.Interior.Color = RGB(146, 208, 80)
                Case "UAT"
                    n.Interior.Color = RGB(255, 255, 0)
                Case "In Progress"
                    n.Interior.Color = RGB(255, 255, 0)
                Case "ANALYTICS"
                    n.Interior.Color = RGB(255, 255, 0)
                Case "IN QUEUE"
                    n.Interior.Color = RGB(255, 204, 255)
                Case "ESTIMATION"
                    n.Interior.Color = RGB(155, 194, 230)
                Case "Closed"
                    n.Interior.Color = RGB(242, 242, 242)
            End Select
        Next n
    End With
    
    lLastRow = Sheets("general_report").Cells(Rows.Count, 1).End(xlUp).Row
 
    For i = 1 To lLastRow
    
    If Cells(i, 6).Interior.Color = RGB(146, 208, 80) Then Range(Cells(i, 1), Cells(i, 7)).Interior.Color = RGB(146, 208, 80)
    If Cells(i, 6).Interior.Color = RGB(255, 255, 0) Then Range(Cells(i, 1), Cells(i, 7)).Interior.Color = RGB(255, 255, 0)
    If Cells(i, 6).Interior.Color = RGB(255, 204, 255) Then Range(Cells(i, 1), Cells(i, 7)).Interior.Color = RGB(255, 204, 255)
    If Cells(i, 6).Interior.Color = RGB(155, 194, 230) Then Range(Cells(i, 1), Cells(i, 7)).Interior.Color = RGB(155, 194, 230)
    If Cells(i, 6).Interior.Color = RGB(242, 242, 242) Then Range(Cells(i, 1), Cells(i, 7)).Interior.Color = RGB(242, 242, 242)
    
    Next i
    
    
    
    
    
End Sub

Источник

alcnwndrlnd

Пользователь

Сообщений: 44
Регистрация: 08.12.2015

08.12.2015 10:03:45

Всем привет!
Помогите, пожалуйста, с макросом для Excel, уже облазила все, что только можно
Нужно сделать так, чтобы макрос «пробегал» значения в определенном столбце и раскрашивал строки в соответствии с НЕСКОЛЬКИМИ условиями. Пока получается проверять только одно и запускать макрос приходится по нескольку раз, потому что останавливается. Код под спойлером:

Скрытый текст

Уж больно здесь красиво, жди беды..

vdovin_sg Пользователь Сообщений: 58 Регистрация: 02.12.2015	А почему бы не воспользоваться условным форматированием? Можно выделить нужный столбец и задать в разделе условное форматирование нужные условия. Сколько необходимо!

	vdovin_sg, хотелось бы макросом как-то автоматизировать процесс, нажатием одной кнопки, так сказать, а условное форматирование каждый раз добавлять. Уж больно здесь красиво, жди беды..

vdovin_sg Пользователь Сообщений: 58 Регистрация: 02.12.2015	alcnwndrlnd, Ясно, в макросах я не силен, сам только учусь.

	vdovin_sg, вот и я тоже, пока что но все еще впереди Уж больно здесь красиво, жди беды..

vdovin_sg

Пользователь

Сообщений: 58
Регистрация: 02.12.2015

08.12.2015 10:29:55

а если попробовать использовать цикл for a=1 to 500

Код

Sub Start()
Fill_Color Range("A1:A500")
End Sub

Sub Fill_Color(Rg As Range)
Dim cel As Range
For Each cel In Rg
a = cel.Value
[B]For a = 1 To 500[/B]
If a = 1 Then
cel.EntireRow.Interior.Color = QBColor(5)
ElseIf a = 2 Then
cel.EntireRow.Interior.Color = QBColor(3)
End If
[B]Next a[/B]
Next
End Sub

	vdovin_sg, идея хорошая, а что делать с проверкой нескольких значений? в разных else if — ах расписать только если Уж больно здесь красиво, жди беды..

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

08.12.2015 10:52:25

Код

Sub Fill_Color()
Dim i As Long
Range("A1:A500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 500
 If Cells(i, 1) = 1 Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 1) = 2 Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
Next
End Sub

k61

Пользователь

Сообщений: 2441
Регистрация: 21.12.2012

08.12.2015 10:56:17

Код

Sub Fill_Color_2()
Dim cel As Range
Cells.Interior.ColorIndex = xlNone
For Each cel In Columns(1).SpecialCells(2, 1)
If cel = 1 Or cel = 2 Then cel.EntireRow.Interior.Color = QBColor(7 - cel.Value * 2)
Next
End Sub

	Kuzmich, k61, тааак, спасибо, сейчас поразбираюсь.. в принципе реально вставить вместо «1» и «2» текстовые значения? Уж больно здесь красиво, жди беды..

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012

alcnwndrlnd

Пользователь

Сообщений: 44
Регистрация: 08.12.2015

#12

08.12.2015 11:27:25

Kuzmich, в таком случае, подскажите, пожалуйста, синтаксис. Как-то надо сослаться на текстовое значение? Ох уж этот ВБА, с++ и то легче.. голова уже кругом

Код

Sub Fill_Color()
Dim i As Long
Range("A1:A500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 500
 If Cells(i, 1) = "мама" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 1) = "мыла" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 If Cells(i, 1) = "раму" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6

Next
End Sub

Изменено: alcnwndrlnd — 08.12.2015 11:27:44

Уж больно здесь красиво, жди беды..

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012	А что не получается. Строку с «раму» видимо надо посветить другим цветом (6 заменить)

	Kuzmich, да, проблема была именно в этом, макрос просто не выполнялся что ж, всем большое спасибо и огромный «+» в карму! vdovin_sg, k61, Kuzmich Уж больно здесь красиво, жди беды..

alcnwndrlnd

Пользователь

Сообщений: 44
Регистрация: 08.12.2015

#15

08.12.2015 11:47:50

Kuzmich, и, наверное, последний вопрос.. Возможно, глупый: как проверить несколько значений и раскрасить одним цветом:

Код

Sub Fill_Color()
Dim i As Long
Range("A1:A500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 500
 If Cells(i, 1) = "мама" Or "мыла" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 1) = "абракадабра" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 If Cells(i, 1) = "раму" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 8
Next
End Sub

Изменено: alcnwndrlnd — 08.12.2015 11:48:18

Уж больно здесь красиво, жди беды..

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#16

08.12.2015 11:51:05

Код
If Cells(i, 1) = "мама" Or Cells(i, 1) ="мыла" Then

	Kuzmich, «а ларчик просто открывался» спасибо еще раз, огромное Уж больно здесь красиво, жди беды..

alcnwndrlnd

Пользователь

Сообщений: 44
Регистрация: 08.12.2015

#18

08.12.2015 12:08:28

Kuzmich, потревожу Вас еще раз. Не получается добавить просмотр следующего интересующего меня столбца, после прохождения первого

Код
Range("A1:A500", "B1:B500").EntireRow.Interior.ColorIndex = -4142

так?

Уж больно здесь красиво, жди беды..

Михаил Лебедев

Пользователь

Сообщений: 2855
Регистрация: 17.01.2013

#19

08.12.2015 12:22:39

попробуйте так:

Код

Sub Fill_Color()
Dim rng As Range
Dim rng2 As Range
Set rng = Range("A1:B500")
rng.EntireRow.Interior.ColorIndex = -4142
For Each rng2 In rng
 If rng2 = "мама" Or "мыла" Then rng2.EntireRow.Interior.ColorIndex = 4
 If rng2 = "абракадабра" Then rng2.EntireRow.Interior.ColorIndex = 6
 If rng2 = "раму" Then rng2.EntireRow.Interior.ColorIndex = 8
Next
Set rng = Nothing
End Sub

Изменено: Михаил Лебедев — 10.12.2015 11:57:00
(исправил диапазон (спасибо Kuzmich-у))

Всё сложное — не нужно. Всё нужное — просто /М. Т. Калашников/

	Уж больно здесь красиво, жди беды..

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#21

08.12.2015 12:42:39

Код
Range("A1:B500").EntireRow.Interior.ColorIndex = -4142

	Kuzmich, пробовала, второй столбец не красит, но и ошибку не выдает Уж больно здесь красиво, жди беды..

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#23

08.12.2015 12:46:23

Код
Range("A1:A500,B1:B500")

	Файл выложите. И/или поменяйте строку в моем коде, как предложил «кузмич» (я в своем предыдущем — поменял) Изменено: Михаил Лебедев — 08.12.2015 13:04:02 Всё сложное — не нужно. Всё нужное — просто /М. Т. Калашников/

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#25

08.12.2015 13:04:42

Цитата
второй столбец не красит

Какой столбец? Когда подсвечивается вся строка.
Или не красит по условию второго столбца?

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012	Cells(i,2) — это будет второй столбец

Михаил Лебедев

Пользователь

Сообщений: 2855
Регистрация: 17.01.2013

#27

08.12.2015 13:20:58

Код

Sub Fill_Color()
    Dim rng As Range
    Dim rng2 As Range
    Set rng = Range("A1:B10")
    rng.EntireRow.Interior.ColorIndex = -4142
    For Each rng2 In rng
        If rng2.Value2 = "мама" Or rng2.Value2 = "мыла" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 4
        If rng2.Value2 = "абракадабра" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 6
        If rng2.Value2 = "раму" Then Cells(rng2.Row, 1).EntireRow.Interior.ColorIndex = 8
    Next
    Set rng = Nothing
End Sub

Изменено: Михаил Лебедев — 08.12.2015 13:21:20

Всё сложное — не нужно. Всё нужное — просто /М. Т. Калашников/

Юрий М Модератор Сообщений: 60575 Регистрация: 14.09.2012 Контакты см. в профиле	alcnwndrlnd и vdovin_sg, код следует оформлять тегом — ищите такую кнопку (см. скрин). alcnwndrlnd, поменяйте, пожалуйста, в своём профиле отображаемое имя — сейчас оно с нарушением Правил. Спасибо!

alcnwndrlnd

Пользователь

Сообщений: 44
Регистрация: 08.12.2015

#29

08.12.2015 13:46:53

Цитата
Kuzmich написал: Какой столбец? Когда подсвечивается вся строка. Или не красит по условию второго столбца?

Да, по условию. Сейчас попробую с исправлениями

Уж больно здесь красиво, жди беды..

alcnwndrlnd

Пользователь

Сообщений: 44
Регистрация: 08.12.2015

#30

08.12.2015 14:39:05

Михаил Лебедев, спасибо! Kuzmich, и снова, еще раз спасибо! во всем разобралась, все работает, как надо

Код

Sub Fill_Color()
Dim i As Long
Range("A1:A500, B1:B500").EntireRow.Interior.ColorIndex = -4142
For i = 1 To 5000
 If Cells(i, 1) = "а" Or Cells(i, 1) = б" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 4
 If Cells(i, 2) = "в" Or Cells(i, 2) = "г" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 5
 If Cells(i, 1) = "д" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
 If Cells(i, 1) = "е" Then Cells(i, 1).EntireRow.Interior.ColorIndex = 8
 
Next
End Sub

Изменено: alcnwndrlnd — 08.12.2015 14:39:41

Уж больно здесь красиво, жди беды..

Источник

Закрашивание строки цветом исходя из активной ячейки

DrRoy

Дата: Пятница, 31.05.2013, 16:05 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 21

Репутация:
0
±

Замечаний:
0% ±

В таблице может быть активной любая ячейка. Нужен макрос, который красит строку с активной ячейкой в желтый цвет.
Это мои извращения:
[vba]

Код

Range(«A» & ActiveCell.Row:»U» & ActiveCell.Row).Select
Selection.Interior.ColorIndex = 6

[/vba]
А как правильно?

К сообщению приложен файл:

4040909.xls
(15.5 Kb)

Ответить

AlexM

Дата: Пятница, 31.05.2013, 19:40 |
Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4257

Репутация:
1046
±

Замечаний:
0% ±

Excel 2003

Если таблицу сделать не такой пестрой, то можно так.
Код вставить в модуль листа.
[vba]

Код

Public r As Long, ci As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If r <> Empty And ci <> Empty Then
Range(Cells(r, 1), Cells(r, 21)).Interior.ColorIndex = ci
End If
r = Target.Row
ci = Target.Interior.ColorIndex
Range(Cells(r, 1), Cells(r, 21)).Interior.ColorIndex = 6
End Sub

[/vba]

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

DrRoy

Дата: Пятница, 31.05.2013, 20:15 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 21

Репутация:
0
±

Замечаний:
0% ±

Возможно, я не так сформулировал задачу.
Итак. В таблице щелкаем на любую ячейку. Она становится просто активной.
Если в этот момент запустить макрос, то строка с активной ячейкой должна окраситься желтым. Потом можно выбрать другую ячейку, но покрашенная строка должна остаться желтой.

Зачем все это нужно. Диспетчер принимает заказы от магазинов на определенные виды продукции, отмечает их количество в соответствующей строке. После этого запускается макрос вывода на печать, а строка с этим магазином помечается желтым, т.е. заказ принят и на эти цифры на желтом фоне можно не отвлекаться.

Ответить

AlexM

Дата: Пятница, 31.05.2013, 20:47 |
Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4257

Репутация:
1046
±

Замечаний:
0% ±

Excel 2003

А так подойдет?

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

AndreTM

Дата: Пятница, 31.05.2013, 20:51 |
Сообщение № 5

Группа: Друзья

Ранг: Старожил

Сообщений: 1762

Репутация:
498
±

Замечаний:
0% ±

2003 & 2010

DrRoy,
[vba]

Код

Intersect(Columns(«A:U»), ActiveCell.EntireRow).Interior.Color = vbYellow

[/vba]

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Ответить

AlexM

Дата: Пятница, 31.05.2013, 20:54 |
Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4257

Репутация:
1046
±

Замечаний:
0% ±

Excel 2003

Макрос запускается кнопкой

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

DrRoy

Дата: Пятница, 31.05.2013, 21:21 |
Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 21

Репутация:
0
±

Замечаний:
0% ±

AndreTM, спасибо огромное! Это именно то, что было нужно!
AlexM, вам тоже спасибо за труды, кое-что из Ваших формул я для себя тоже взял.

Ответить

Источник