Заливка ячеек в excel по условию vba - Word и Excel - помощь в работе с программами

У Вас лишняя буква 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

Источник

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

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

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

Bema Пользователь Сообщений: 6759 Регистрация: 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 в желтый цвет

я так понял..

Источник

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

Источник

1 / 1 / 0

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

Сообщений: 7

Закрасить ячейки определенным цветом в зависимости от содержимого

26.10.2012, 10:09. Показов 83419. Ответов 23

Здравствуйте. Я не могу разобраться в создании программы.
Мне нужно в определённом диапазоне: ячейки с текстовым символами — залить красным цветом, ячейки с цифрами — жёлтым цвет, а пустые зелёным.
Нужен код программный.
HELP ME!!!

Catstail

Модератор

34707 / 19228 / 4039

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

Сообщений: 32,190

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

26.10.2012, 10:25

Visual Basic

Sub Fill_Color(Rg as Range)
Dim cel as Range
      For each cel in Rg
           v=cel.Value
           If isEmpty(v) then
              cel.interior.color=Qbcolor(10)
           elseIf isNumeric(v) then
              cel.interior.color=Qbcolor(14)
           else
              cel.interior.color=Qbcolor(12)
           end if
      Next
End Sub

1 / 1 / 0

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

Сообщений: 7

26.10.2012, 10:32

[ТС]

Catstail, а можно по-подробнее? Описать каждую строчку) А то ещё сплю на ходу)

15136 / 6410 / 1730

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

Сообщений: 9,999

26.10.2012, 10:33

Условное форматирование не подойдет?

Вложения

УФ.xls (14.0 Кб, 848 просмотров)

1 / 1 / 0

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

Сообщений: 7

26.10.2012, 10:40

[ТС]

Сообщение от Казанский

Условное форматирование не подойдет?

Извините, но нет.

Хотя мб и пойдёт, мне нужен код. Я не давно начал изучать VBA, и поэтому желательно с пояснениями.

Catstail

Модератор

34707 / 19228 / 4039

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

Сообщений: 32,190

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

26.10.2012, 11:57

Visual Basic

Sub Fill_Color(Rg as Range)  ' на вход процедуре подается параметр - диапазон ячеек
Dim cel as Range                ' рабочая переменная (которая будет пробегать по диапазону)
      For each cel in Rg        ' цикл по всем ячейкам диапазона (у ячейки тип - тоже Range)
           v=cel.Value            ' берем значение очередной ячейки
           If isEmpty(v) then                    ' если ячейка пуста -
              cel.interior.color=Qbcolor(10)   ' заливаем зеленым (код 10)
           elseIf isNumeric(v) then             ' если в ячейке число -
              cel.interior.color=Qbcolor(14)   ' заливаем желтым (код 14)
           else                                       ' иначе
              cel.interior.color=Qbcolor(12)   ' заливаем желтым (код 10)
           end if
      Next
End Sub

Вот запускающая процедура:

Visual Basic

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

Модератор

34707 / 19228 / 4039

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

Сообщений: 32,190

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

26.10.2012, 12:03

Вот и картинка:

Изображения

Hugo121

6875 / 2807 / 533

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

Сообщений: 8,562

26.10.2012, 13:16

Visual Basic

Sub tt()
    With Range("A1:B5")
        .SpecialCells(xlCellTypeBlanks).Interior.Color = vbGreen
        .SpecialCells(xlCellTypeConstants, 1).Interior.Color = vbYellow
        .SpecialCells(xlCellTypeConstants, 2).Interior.Color = vbRed
    End With
End Sub

Добавлено через 9 минут
Либо тоже самое короче, но непонятнее:

Visual Basic

Sub tt()
    With Range("A1:B5")
        .SpecialCells(4).Interior.Color = vbGreen
        .SpecialCells(2, 1).Interior.Color = vbYellow
        .SpecialCells(2, 2).Interior.Color = vbRed
    End With
End Sub

Модератор

34707 / 19228 / 4039

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

Сообщений: 32,190

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

26.10.2012, 14:39

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

Либо тоже самое короче, но непонятнее:

— а если числа и строки будут расположены по-другому, Ваш код раскрасит их правильно (в соотв. с заданием TC)?

Казанский

15136 / 6410 / 1730

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

Сообщений: 9,999

26.10.2012, 15:35

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

— Условное форматирование не подойдет?
— Извините, но нет. Хотя мб и пойдёт, мне нужен код.

Код для применения УФ к выделенному диапазону. Получен правкой кода макрорекордера:

Visual Basic

Sub Макрос1()
Dim a$
a = ActiveCell.Address(0, 0)
With Selection.FormatConditions
    .Delete
    .Add Type:=xlExpression, Formula1:="=ЕТЕКСТ(" & a & ")"
    .Item(1).Interior.ColorIndex = 3
    .Add Type:=xlExpression, Formula1:="=ЕЧИСЛО(" & a & ")"
    .Item(2).Interior.ColorIndex = 27
    .Add Type:=xlExpression, Formula1:="=" & a & "="""""
    .Item(3).Interior.ColorIndex = 4
End With
End Sub

В файле поста #4 было 2 условия УФ, т.е. ячейки изначально имели зеленый фон. Здесь я добавил зеленую заливку в условие УФ. Теперь ячейки, содержащие значение ошибки (это не число, не текст и не пусто) будут оставаться неокрашенными.

Добавлено через 10 минут

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

— а если числа и строки будут расположены по-другому, Ваш код раскрасит их правильно (в соотв. с заданием TC)?

Да. С кодом Hugo121 другие проблемы:
1. Надо добавить on error resume next, иначе будет ошибка, если в диапазоне не найдется ячеек указанного типа.
2. Этот метод выбирает только ячейки с константами. Для ячеек с формулами надо дописать такие же команды

Visual Basic

1 2	.SpecialCells(xlCellTypeFormulas, 1).Interior.Color = vbYellow .SpecialCells(xlCellTypeFormulas, 2).Interior.Color = vbRed

1 / 1 / 0

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

Сообщений: 7

30.10.2012, 23:17

[ТС]

Всем доброго времени суток. Не могу понять, что написать для того что бы закрашивались ячейки, в зависимости от содержимого.
Ячейки содержимое которых — цифры нужно закрасить жёлтым цветом.
Ячейки содержимое которых — буквы нужно закрасить синим цветом.
Ячейки у которых нет содержимого(пустые) — нужно закрасить красным цветом.

Приложен файл. Лучше всего писать коды в нём. Заранее благодарю

1177 / 419 / 106

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

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

31.10.2012, 10:34

А что мешает поставить правильную задачу в соответствии правилами форума, в частности с п. 4.1
Если стандартный поиск по форуму не дал результатов, то даю наВодку, как искать по форуму с помощью гугла на этом или любом другом сайте. В поисковой строке вбиваем: site:сyberforum.ru(пробел)искомый_текст

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

Приложен файл. Лучше всего писать коды в нём.

Куда приложен?, где лучше писАть коды?

Не по теме:

PS. никак не смог избавиться от цитирования cyberforum.ru в качестве ссылки для указания в качестве поисковой строки, потому использовал вместо настоящего пробела — это слово в скобках

5468 / 1148 / 50

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

Сообщений: 3,514

31.10.2012, 11:48

Никогда не пользуюсь поиском на этом форуме, т.к. невозможно ничего найти.
Всегда использую Гугл или Яндекс. Кстати через Гугл и Яндекс и находятся темы на этом форуме, поэтому считаю, что в названия тем нужно добавлять название языка программирования, например:
Как сделать то-то в VBA.
Просто по правилам форума нельзя указывать название языка программирования в теме, если тема находится в определённом разделе форума, связанном с этим языком программирования.

Catstail

Модератор

34707 / 19228 / 4039

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

Сообщений: 32,190

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

31.10.2012, 12:18

Сообщение от Казанский

Да. С кодом Hugo121 другие проблемы:

Да??? Я про вот этот код:

Visual Basic

Sub tt()
    With Range("A1:B5")
        .SpecialCells(4).Interior.Color = vbGreen
        .SpecialCells(2, 1).Interior.Color = vbYellow
        .SpecialCells(2, 2).Interior.Color = vbRed
    End With
End Sub

Хотя, действительно ДА. Я неправ…

1 / 1 / 0

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

Сообщений: 7

31.10.2012, 12:44

[ТС]

Вот он(файл)

1 / 1 / 0

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

Сообщений: 329

27.05.2015, 13:34

Catstail, пожалуйста, можно палитру цветов с кодами (если их много)
Буду очень признательна

Модератор

34707 / 19228 / 4039

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

Сообщений: 32,190

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

27.05.2015, 14:24

1 / 1 / 0

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

Сообщений: 329

27.05.2015, 14:24

Так это же иконки, а мне нужна заливка ячеек

3827 / 2254 / 751

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

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

27.05.2015, 14:26

Сообщение от Оксана33

Так это же иконки, а мне нужна заливка ячеек

смотрите лист КОДЫ левее иконок.

1 / 1 / 0

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

Сообщений: 329

27.05.2015, 16:27

нашла, спасибо. открывала коды-0

Добавлено через 1 час 54 минуты
хочу у вас уточнить, та таблица с цветами не имеет отношение к вышеизложенному коду
cel.interior.color=Qbcolor(12)
так как этот код прописывается colorindex=…
а что это Qbcolor и почему Qb?
кажется я это искала https://msdn.microsoft.com/en-… s.90).aspx

IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604	27.05.2015, 16:27
20

Источник

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

Dendibar

Дата: Понедельник, 21.03.2016, 19:04 |
Сообщение № 1

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

Ранг: Прохожий

Сообщений: 8

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

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

Excel 2007

Добрый день!

Подскажите пожалуйста, как можно с помощью макроса закрасить ячейки на пересечении 2 значений (одно по строке, другое по столбцу)?
С помощью условного форматирования знаю как — но мне нужно сделать это макросом.
Пример прилагаю — там описаны условия и как должно выглядеть на выходе (цвет не принципиален — мне бы понять принцип).
Заранее благодарю за помощь!

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

3012255.xlsx
(35.5 Kb)

Ответить

Karataev

Дата: Понедельник, 21.03.2016, 19:18 |
Сообщение № 2

Группа: Проверенные

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

Сообщений: 1330

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

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

Excel

[vba]

Код

Sub Закрасить()

Dim i As Long, j As Long, strSearchText As String

Application.ScreenUpdating = False

Range(«B2:D7»).Interior.ColorIndex = xlColorIndexNone

        For i = 2 To 7
        Select Case Cells(i, 1).Value
            Case «Ф1»
                strSearchText = «Значение 1»
            Case «Ф2»
                strSearchText = «Значение 2»
        End Select
        For j = 2 To 4
            If Cells(1, j).Value = strSearchText Then
                Cells(i, j).Interior.ColorIndex = 6
            End If
        Next
    Next

Application.ScreenUpdating = True

MsgBox «Готово!», vbInformation

End Sub

[/vba]

Киви-кошелек: 9166309108

Ответить

Dendibar

Дата: Понедельник, 21.03.2016, 19:41 |
Сообщение № 3

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

Ранг: Прохожий

Сообщений: 8

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

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

Excel 2007

Karataev, большое спасибо!

Если меняю диапазоны:
[vba]

Код

С For i = 2 To 7 на For i = 1 To 50

[/vba]
и
[vba]

Код

С For j = 2 To 7 на For j = 1 To 50

[/vba]
почему-то полностью закрашивает весь 2ой столбец и всю первую строку не зависимо от того, выполняется условие, или нет.
Подскажите, в каком месте криво делаю?
[moder]Оформляйте коды тегами (кнопка #)[/moder]

Сообщение отредактировал Dendibar — Понедельник, 21.03.2016, 22:52

Ответить

Karataev

Дата: Понедельник, 21.03.2016, 19:58 |
Сообщение № 4

Группа: Проверенные

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

Сообщений: 1330

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

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

Excel

Обратите внимание, что у меня макрос работает, начиная со 2-ой строки и со 2-го столбца, т.к. в первом столбце и первой строке находятся заголовки.

Киви-кошелек: 9166309108

Ответить

Udik

Дата: Понедельник, 21.03.2016, 20:00 |
Сообщение № 5

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

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

Сообщений: 1588

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

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

Excel 2016 х 64

так можно
[vba]

Код

Dim lName As String
Dim lastRow As Integer

Public Sub test()
lName = «Лист1»
lastRow = 7
Call paint(«Ф1», 2, VBA.RGB(255, 0, 0)) ‘2-й столбец и свой цвет
Call paint(«Ф2», 3, VBA.RGB(0, 255, 0)) ‘3-й столбец и свой цвет

End Sub

Public Sub paint(str1 As String, numCol As Integer, cellColor As Long)
Dim c1 As Range

With Worksheets(lName)
For Each c1 In .Range(.Cells(2, numCol), .Cells(lastRow, numCol))
If c1.Offset(0, 1 — numCol).Text = str1 Then c1.Interior.Color = cellColor
Next
End With
End Function

[/vba]

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

0t.xlsm
(15.9 Kb)

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Сообщение отредактировал Udik — Понедельник, 21.03.2016, 20:02

Ответить

Wasilich

Дата: Понедельник, 21.03.2016, 20:08 |
Сообщение № 6

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

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

Сообщений: 1232

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

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

2003

Согласно примера
For i = 2 To 7 — Цикл прохода по строкам со 2-й по 7-ю
For j = 2 To 4 — Цикл прохода по столбцам со 2-го по 4-й внутри цикла по строкам.
Вы поставили For i = 1 To 50 и For j = 1 To 50
У вас там что 50 строк и 50 столбцов? Покажите, что вы там намудрили, автор макроса тоже не экстрасенс.

Ответить

al-Ex

Дата: Понедельник, 21.03.2016, 20:14 |
Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 190

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

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

Excel 2010

Вот, в любом диапазоне работает:[moder] al-Ex, хорош уже шалить. Вы, надеюсь, поняли, о чем я.[/moder][p.s.]* исправился ), виноват.

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

krsk.xlsm
(16.4 Kb)

Сообщение отредактировал al-Ex — Вторник, 22.03.2016, 01:42

Ответить

StoTisteg

Дата: Понедельник, 21.03.2016, 20:54 |
Сообщение № 8

Группа: Авторы

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

Сообщений: 1161

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

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

Excel 2010

al-Ex, а если оно ещё и начинается не с начала?

Интуитивно понятный код — это когда интуитивно понятно, что это код.

Ответить

Dendibar

Дата: Вторник, 22.03.2016, 00:01 |
Сообщение № 9

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

Ранг: Прохожий

Сообщений: 8

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

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

Excel 2007

Спасибо Всем огромное за помощь и подробные объяснения — очень выручили!
Все варианты подошли. Отедельное спасибо al-Ex — самый удобный вариант, так как не привязан к конкретному диапазону)

Ответить

Источник