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 цветов, а также о том, как добавить узор в ячейку.

Источник

Доброго времени суток, Друзья!
Подскажите как создать макрос по условию
К примеру если значение ячейки H = -7, I = -4, J = 5 и O = 0.85, то окрасить ячейку Q в желтый цвет, а так же
если H = -10, I = 22, J = 27 и O = 0.68, то окрасить ячейку R в желтый цвет
Всем заранее спасибо

Bema Пользователь Сообщений: 6750 Регистрация: 15.02.2016	Алексей, добрый и Вам. Обязательно нужен макрос? Можно и при помощи УФ такое сделать. Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл

	Bema , и Вам доброго….без макроса никуда к сожалению Очень много данных в таблице реальной…сюда ее не загрузить…весит почти 10Mb

Bema Пользователь Сообщений: 6750 Регистрация: 15.02.2016	Дело хозяйское Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл

А если бы в макросе были бы еще комментарии что за что отвечает и счетчик сколько то или иное условие встречалось ранее(вывод счетчика в той же окрашенной ячейки), то этот макрос был бы очень хорошим)
Ну как минимум можно было бы в дальнейшем при создании подобного условия легко разобраться как его сделать

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

	Kuzmich , возможности сделать хотя бы очень маленький пример не имею т.к. незнаю как…

Kuzmich

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

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

05.07.2017 21:36:15

Макрос (в модуль листа) срабатывает на изменение значений в ячейках столбцов H:O
Счетчик сколько то или иное условие встречалось внизу таблицы

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("H:O")) Is Nothing Then
        Application.EnableEvents = False
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("Q1:R" & iLastRow).ClearContents
    Range("Q1:R" & iLastRow).Interior.ColorIndex = xlColorIndexNone
  For i = 1 To iLastRow
    If Cells(i, 8) = "7" And Cells(i, 9) = "4" And Cells(i, 10) = "5" And Cells(i, 15) = "0.85" Then
      Cells(i, 17) = 1
      Cells(i, 17).Interior.ColorIndex = 6
    End If
    If Cells(i, 8) = "10" And Cells(i, 9) = "22" And Cells(i, 10) = "27" And Cells(i, 15) = "0.68" Then
      Cells(i, 18) = 1
      Cells(i, 18).Interior.ColorIndex = 6
    End If
  Next
     Range("Q" & iLastRow + 1) = Application.Sum(Range("Q1:Q" & iLastRow))
     Range("R" & iLastRow + 1) = Application.Sum(Range("R1:R" & iLastRow))
End If
    Application.EnableEvents = True
End Sub

Kuzmich

, спасибо большое, но у меня чего-то не работает))))
Подозреваю что нужно подключать библиотеки…у меня макбук, а на обычной Виндовс сейчас пока не проверить
И еще маленький вопрос…

Kuzmich

, скажите, а этот счетчик можно вывести именно в ту ячейку которая должна окрасится?
Заранее спасибо

Изменено: Aleksey.g84 — 05.07.2017 21:54:57

Kuzmich

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

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

#10

05.07.2017 22:23:05

Цитата
но у меня чего-то не работает

Скопируйте и вставьте код при русской раскладке клавиатуры
Я в ваш файл вставил код и он заработал при изменении значений в ячейках столбцов H:O

	Kuzmich , не помогает смена раскладки….

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

Kuzmich

, грешу все таки на то, что у меня макбук…
смотрите…удалил уже отмеченные значения…очистил заливку
добавил ниже строчки и ничего не произошло…залез в макросы, выбрал макрос Айсумма, нажал на выполнить и так же тишина)))

Kuzmich

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

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

#14

05.07.2017 23:11:29

Сравните ваши строки в макросе

Код

  For i = 1 To iLastRow
    If Cells(i, 8) = "_7" And Cells(i, 9) = "_4" And Cells(i, 10) = "5" And Cells(i, 15) = "0.85" Then
      Cells(i, 17) = 1
      Cells(i, 17).Interior.ColorIndex = 6
    End If
    If Cells(i, 8) = "_10" And Cells(i, 9) = "22" And Cells(i, 10) = "27" And Cells(i, 15) = "0.68" Then
      Cells(i, 18) = 1
      Cells(i, 18).Interior.ColorIndex = 6
    End If
  Next

И то, что у меня в примере

Изменено: Kuzmich — 05.07.2017 23:27:50

Aleksey.g84

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

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

#15

05.07.2017 23:14:30

совершенно идентичны…

Код

For i = 1 To iLastRow
    If Cells(i, 8) = "_7" And Cells(i, 9) = "_4" And Cells(i, 10) = "5" And Cells(i, 15) = "0.85" Then
      Cells(i, 17) = 1
      Cells(i, 17).Interior.ColorIndex = 6
    End If
    If Cells(i, 8) = "_10" And Cells(i, 9) = "22" And Cells(i, 10) = "27" And Cells(i, 15) = "0.68" Then
      Cells(i, 18) = 1
      Cells(i, 18).Interior.ColorIndex = 6
    End If
 Next

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012	У вас в коде «_7», «_4» и «_10» Скопируйте значения -7, -4 и -10 прямо из соответствующих ячеек в код макроса.

	И все же Kuzmich продолжаю грешить на то, что у меня макбук….сделал как вы сказали…скопировал прямо из книги в редактор…сохранил и ничего)))

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

	Kuzmich , к сожалению нет…. пробовал по разному…добавил строчек…ничего закрыл эксель и не сохранил…. открыл еще раз….очистил уже установленные маркера…полез в макросы…нажал выполнить Айсумма…тоже ничего

vikttur Пользователь Сообщений: 47199 Регистрация: 15.09.2012	Для MAC есть отдельная ветка форума.

Kuzmich

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

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

#21

05.07.2017 23:37:30

Цитата
нажал выполнить Айсумма…тоже ничего

Не надо ничего нажимать. Sub iSumma() это от другого примера
Я вам писал
Макрос (в модуль листа) срабатывает на изменение значений в ячейках столбцов H:O

	vikttur , прекрасно вас понимаю…но на данный момент это похоже на расизм….аааа…у тебя мак…пошел вон от сюда… Виндовс тоже есть…просто сегодня ноут остался на работе

Aleksey.g84

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

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

#23

05.07.2017 23:42:56

Kuzmich

, немного поменял код…
сделал так

Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns("H")) Is Nothing Then Application.EnableEvents = False

получилось ничего)

Прикрепленные файлы

Снимок экрана 2017-07-05 в 23.42.37.png (99.31 КБ)

Kuzmich Пользователь Сообщений: 7998 Регистрация: 21.12.2012	Вы сделали то, что я вам говорил в #16 ?

Obelisk Пользователь Сообщений: 49 Регистрация: 21.06.2017	У меня так получилось, все работает:

vikttur

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

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

#26

05.07.2017 23:49:36

Цитата
Aleksey.g84 написал: на данный момент это похоже на расизм

Да при чем здесь рассизм?! MAC имеет отличия в работе с VBA

	Kuzmich , совершенно верно….сейчас еще раз повторил….

	vikttur , не принимайте близко))) с этим тоже я столкнулся….я о различиях…буду конечно завтра на работе пробовать на Виндовсе

Kuzmich

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

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

#29

05.07.2017 23:56:38

Obelisk

Ваш макрос только для первой строки
и надо

Код
Sub Макрос1() Range("Q1").Interior.Color = vbYellow End Sub

Obelisk

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

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

#30

05.07.2017 23:58:27

Цитата
Aleksey.g84 написал: то окрасить ячейку Q в желтый цвет

я так понял..

Источник

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

Добавить текст ячейки в зависимости от цвета ячейки

12.02.2017, 12:30. Показов 8199. Ответов 16

Здравствуйте. Я не могу разобраться в написании формулы или макроса.
В определенном диапазоне ячеек требуется: в зависимости от цвета ячейки добавить текст с названием цвета в ячейку справа.
Количество цветов ячеек ограниченно.
То есть, если ячейка желтого цвета, то в ячейке справа должен появиться текст «желтый», если красного -«красный».

Нужен код для VBA excel.
HELP ME!!!

aequit

223 / 134 / 45

Регистрация: 08.09.2012

Сообщений: 283

Записей в блоге: 1

12.02.2017, 14:22

Visual Basic

1	if Range("A1").Interior.Color = 65535 Then Range("B1").Value = "Желтый"

Файл нужно прикладывать со своими наработками, что не получилось…
Почему именно VBA? Условным форматированием может удобнее было-бы…

Xiaohny

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

13.02.2017, 11:46

[ТС]

в ячейке D9 находиться пример цвета.

Visual Basic

Public Function examV(DataRange As Range)
     
     If DataRange.Interior.Color = Range("D9").Interior.Color Then Range("B1").Value = "желтый"
     
 End Function

Добавлено через 17 часов 20 минут

Сообщение от aequit

Visual Basic

1	if Range("A1").Interior.Color = 65535 Then Range("B1").Value = "Желтый"

Разве можно задать в словном форматировании условие определения цвета?
Формула, прикрепленная выше не работает, что может быть неправильным?

223 / 134 / 45

Регистрация: 08.09.2012

Сообщений: 283

Записей в блоге: 1

13.02.2017, 14:40

Да, условным форматированием данную задачу нельзя сделать (или я не знаю как)…

Вариант условия из первого поста «если ячейка желтого цвета, то в ячейке справа должен появиться текст «желтый», если красного -«красный» можно реализовать циклом по ячейкам из диапазона «справа» и в зависимости от результата в ячейках «слева» писать текст. Для этого в коде нужно запрограммировать соответствие 65535 = «Желтый» и т.д. Например, используя Select Case.
Прикладываю файл, там номера и названия цветов, может пригодится. Поэкспериментировал с цветами, формулой, как Вы хотели, не получается.
Больше мыслей нет.

Xiaohny

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

13.02.2017, 16:33

[ТС]

Изменил формулу, в результате в ячейке результат «#ЗНАЧ!»
Подозреваю, что неправильно указываю тип переменной, т.к. при использовании формулы цвета из ячеек D9 и D10, то результат #ЗНАЧ!, иначе пустая ячейка.
Что может быть не так в моей формуле?

Visual Basic

Public Function examV1(DataRange As Range, DataRange2 As Range) As String
 
     If DataRange.Interior.Color = Range("D9").Interior.Color Then DataRange2.Value = "желтый"
     If DataRange.Interior.Color = Range("D10").Interior.Color Then DataRange2.Value = "красный"
     
 End Function

Вложения

color-vba-2017.xlsm.xlsx (9.4 Кб, 14 просмотров)

es geht mir gut

11264 / 4746 / 1183

Регистрация: 27.07.2011

Сообщений: 11,437

13.02.2017, 16:38

Сообщение от Xiaohny

Что может быть не так в моей формуле?

А функции-то и нет.

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

13.02.2017, 16:40

[ТС]

Прикрепить файл с макросом не могу, пардоньте

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,928

13.02.2017, 16:51

заархивируйте тогда прицепится.

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

13.02.2017, 16:54

[ТС]

Готово.
Функция examV1

Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,928

13.02.2017, 16:58

Сообщение было отмечено Xiaohny как решение

Решение

для начала так. файл не смотрел

Visual Basic

Public Function examV1(DataRange As Range) As String
 
     If DataRange.Interior.Color = Range("D9").Interior.Color Then examV1 = "æåëòûé"
     If DataRange.Interior.Color = Range("D10").Interior.Color Then examV1 = "êðàñíûé"
     
 End Function

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

13.02.2017, 17:19

[ТС]

Работает, спасибо!

aequit

223 / 134 / 45

Регистрация: 08.09.2012

Сообщений: 283

Записей в блоге: 1

13.02.2017, 17:20

Так тоже можно функцию сделать без создания вспомогательных ячеек. Циферки кодов цветов я выше в файле кидал

Visual Basic

Public Function examV1(DataRange As Range) As String
   Select Case DataRange.Interior.Color
     Case Is = 65535: examV1 = "Желтый"
     Case Is = 255: examV1 = "Красный"
   End Select
 End Function

Xiaohny

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

14.02.2017, 15:21

[ТС]

Функция работает только при вводе вручную, но при автозаполнении результатов не дает.
В чем может быть проблема?

Visual Basic

Public Function examV2(DataRange As Range, DataRange1 As Range)
 
     If DataRange = "желтый" Then DataRange1.Interior.Color = Range("D9").Interior.Color
     If DataRange = "красный" Then DataRange1.Interior.Color = Range("D10").Interior.Color
     
 End Function

Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,928

14.02.2017, 16:00

добавьте второй строкой

Visual Basic

1	Application.Volatile

1 / 1 / 0

Регистрация: 12.02.2017

Сообщений: 52

14.02.2017, 16:27

[ТС]

Не работает

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,928

14.02.2017, 17:52

вы опять не правильно пишите ф-цию. у вас в ф-ции должна быть строка examV2=….., а у вас её нет.

1062 / 506 / 137

Регистрация: 27.02.2013

Сообщений: 1,451

14.02.2017, 19:34

Сообщение было отмечено Xiaohny как решение

Решение

Xiaohny, посмотрите файл.Я когда-то занимался подобной проблемой.Там я привел пример как вам надо используя функции ClosestRGBConstantColorName() и CellColor(),объединив их.
P.S. Названия цветов и их значения вбиваются в соответствующие массивы

IT_Exp

Эксперт

87844 / 49110 / 22898

Регистрация: 17.06.2006

Сообщений: 92,604

14.02.2017, 19:34

Помогаю со студенческими работами здесь

Изменение цвета строки(ячейки) в зависимости от свойств реквизита спрв
Как в зависимости от свойств реквизита справочника,документа,ячейки таблицы значений можно…

Изменение цвета ячейки в таблице Excel в зависимости от сегодняшней даты
День добрый!! Подскажите пожалуйста, как настроить таблицу Эксель, что бы менялся цвет ячейки в…

Как задать значение для ячейки в зависимости от значения другой ячейки
Здравствуйте! Подскажите, как задать значение для ячейки в зависимости от значения другой ячейки….

Изменения формата ячейки Excel средствами VBA в зависимости от значения другой ячейки
Здравствуйте.
Столкнулся с проблемой. Необходимо на листе Excel Залить, предположим, ячейку "C4"…

Перенесение результатов ячейки в ячейку на другой лист, в зависимости от значения исходной ячейки
Добрый день, — прошу помощи экспертов! Есть такая таблица (в вложении).
Суть вопроса такова:
Есть…

Изменения формата ячейки в зависимости от значения другой ячейки
Здравствуйте, помогите решить такой вопрос.

Задача, которая в принципе решается средствами…

Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:

Источник

I don’t know how to code in VBA but am trying to automate an if/then calculation based on cell color.

So I have many cells that are filled in with the RGB color code RGB (255, 235, 156). What I would like to do is take every cell from the range A1:G10000 and if they are filled in with this color, I would like to have them turn bold, italics, red, and have the cell’s fill color to turn to white. I have playing around with the code and so far have found that to this code will make the font red, bold and italics:

Selection.Font.Bold = True

Selection.Font.Italic = True

With Selection.Font

.Color = -16776961

.TintAndShade = 0

However, I have tried using parts of the code from other discussions to make this work in the IF function, and have not yet been able to. I would greatly appreciate if anyone is able to help me write this code. Thank you so much

Источник