Окрасить ячейку по условию excel vba - 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

Источник

Закрасить ячейки по условию 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 — самый удобный вариант, так как не привязан к конкретному диапазону)

Ответить

Источник

Иван Ж

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

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

Здравствуйте!
прошу помощи в составлении макроса для решения задача. Она состоит в том, чтобы закрасить все ячейки градиентом (в определенном диапазоне «B3:G3») которые попадают под несколько условий:
— закрашиваемая ячейка(книга1) имеет определенный цвет заливки (серый через RGB 161, 161, 161)
— дата в столбце закрашиваемой ячейки(книга1) сходится с датой в строке проверяемой ячейки (книга2)
— значение исходной ячейки(книга1) сходится со значением в строке проверяемой ячейки (книга2)
— проверяемая ячейка (книга2) имеет определенный цвет шрифта (серый через RGB 161, 161, 161)
Исходная ячейка (книга1) — «А2», сверяется со столбцом D (книга2)

Прикладываю два файла: Книга1 и Книга2.

Изменено: Иван Ж — 26.05.2021 18:41:56

Mershik

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

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

26.05.2021 20:48:30

Цитата
Иван Ж написал: прошу помощи в составлении макроса

почему не называть все своими именами — сделать за вас)

Не бойтесь совершенства. Вам его не достичь.

Иван Ж

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

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

26.05.2021 21:19:33

Согласен с вам, правильнее было бы написать именно так. Т.к. на данный момент я не очень понимаю с чего нужно начать (как именно задать параметры и условия проверки).
У меня есть один простой макрос для закрашивания ячеек по условию (серый цвет ячеек «шапки»). Но основная проблема моей задачи заключается в том, что простой проверки по цвету ячейки/цвету шрифта недостаточно, нужна первоначальная проверка(поиск) нужной ячейки, а потом уже проверка по цвету.
Как это сделать — загадка для меня.

Код

Sub ЦветСерый()
Dim r1 As Range, r2 As Range, r3 As Range
Dim c As Range
Set r1 = Range("B3:G5")

For Each c In r1
If ((Cells("1", c.Column).Interior.Color = RGB(161, 161, 161)) 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 = RGB(161, 161, 161)
Set r1 = Nothing: Set r2 = Nothing
End Sub

Jack Famous

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

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

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Иван Ж, здравствуйте
1. не собирайте в один диапазон, а красоте прямо в цикле — так будет намного быстрее и кода меньше
2. RGB — это хоть и быстрая, но всё равно функция, так что запомните в лонг-переменную результат серого цвета и сравнивайте с переменной. Тем более, что и шрифт и фон одного цвета

Не понял, с чем у вас проблема — сформулируйте точнее и короче

Изменено: Jack Famous — 26.05.2021 22:15:18

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Иван Ж

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

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

27.05.2021 06:55:07

Цитата
Jack Famous написал: Не понял, с чем у вас проблема — сформулируйте точнее и короче

К сожалению, получилось не очень коротко, но я постарался более точно описать предполагаемый механизм работы/результата.
На примере ячейки B3 (книга1):
1) сверяем дату B2 (книга1) со столбцом B (книга2) — *ищем строки с нужными датами*
2) сверяем ячейку A2 (книга1) со столбцом D (книга2) — *ищем строки с нужными значениями*
3) сверяем, что в ячейке B3 (книга1) цвет ячейки серый (первоначально был серый) и в подходящей строке, исходя из п.1 и п.2, шрифт у даты B3 (книга2) имеет серый цвет
4) заливаем B3 (книга1) градиентной заливкой серый-красный

У меня пока трудности со сложным кодом (где объединяются несколько действий). Т.е. лучше больше (длиннее), но понятнее — сказывается отсутствие большого опыта. Попробую разобраться в ваших пунктах 1 и 2, надеюсь, что пойму. спасибо за совет!

Jack Famous

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

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

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Иван Ж, если вы вообще не понимаете в коде, то какой смысл городить такую пирамиду условий, если решение вы даже не поймёте
1. Возьмите одно условие и по нему сделайте пример
2. Опираться на цвет в качестве аргумента можно, но крайне рискованно — категорически не рекомендую
3. Если прислушаетесь к п.2, и в качестве критериев будут значения, то решения будут намного проще, быстрее и стабильнее (это и заливки найденного качается)

Изменено: Jack Famous — 27.05.2021 09:20:32

Иван Ж

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

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

27.05.2021 19:51:32

Цитата
Jack Famous написал: если вы вообще не понимаете в коде, то какой смысл городить такую пирамиду условий, если решение вы даже не поймёте

Не уверен, что я вас правильно понял. Условия, вроде-как, вполне ясные. На мой взгляд у меня проблема именно в составлении правильного-работающего кода, с последовательностью: цикл проверки — цикл вывода результата.
Я постарался отразить то, что мне нужно в виде кода (ниже). Возможно, получился какой-то «несвязный бред», но уж.. на, что хватило опыта и понимания VBA

Код

Sub условия()
    Dim a, a2, a3, i As Long, i2 As Long, n As Long, lcol As Long, b As Range
    Set b = [a2]
    Set wb = ThisWorkbook: Set wb2 = Workbooks("Книга2.xlsx")
    lcol = Cells(1, Columns.Count).End(xlToLeft).Column
    a1 = wb2.Sheets("Лист1").Range("B2:E")
    a2 = wb.Sheets("Лист1").Range(Cells(1, 2), Cells(3, lcol))
    a3 = wb.Sheets("Лист1").Range(Cells(3, 2), Cells(3, lcol))
        If a2(1, i) = a1(n, 2) And a1(n, 4) = b And a1(n, 5) = 1 And a3 <> "" Then
' если условия совпадают, то красим ячейку в нужный цвет
        End If
End Sub

Исходя из вашего совета (пункт 2), убрал из условий проверку по цвету, заменил ее дополнительным значением (в книге2, столбец E, значение 1) и проверкой на наличие в ячейке данных (для закрашиваемой ячейки книга1 — не равно «пусто» или <>»»). Файлы дополнительно приложил.

Если мой код, хоть как-то похож на «заготовку» для нормального макроса, который будет выполнять требуемую мне задачу, прошу подсказать (дописать за меня©

Mershik

) недостающие строки.

Цитата
Jack Famous написал: категорически не рекомендую

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

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

Книга2.xlsx (8.57 КБ)
Книга1.xlsx (8.87 КБ)

Изменено: Иван Ж — 27.05.2021 19:53:35

Jack Famous

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

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

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Иван Ж, почему значения лучше заливки:
1. значения можно забрать с листа в массив и читать в оперативной памяти — это очень быстро
С заливкой, шрифтом, и прочими атрибутами ячейки, кроме значения, придется работать поячеечно — это долго
2. групп оттенков любого цвета, которые человек не различит между собой очень много, а для Excel это будут разные цвета (он их легко различает)
Получается, у вас 30 оттенков заливки того, что вы хотите отнести к одной группе, а получите 30 групп или 1 из 30 или вообще ничего не получите
3. привыкнув ориентироваться на значения, а не цвета, лишитесь множества проблем типа, как считать/суммировать по цвету фона/шрифта, а также не столкнутесь с проблемами и нюансами фильтрации по цветам

Завтра гляну ваши файлы

Иван Ж

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

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

27.05.2021 20:13:55

Цитата
Jack Famous написал: почему значения лучше заливки

Спасибо, понял!
Со вторым пунктом согласен вдвойне, т.к. столкнулся с аналогичной проблемой сам. Копировал ячейки с «одинаковыми» цветами из разных документов, потом долго искал причину «почему оно не работает». Сейчас если очень хочется поиграться с цветом, использую настройку RGB и одинаковые значения цифр.

Jack Famous

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

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

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#10

28.05.2021 10:09:51

Пробуйте

Файл «Книга2.xlsx» должен лежать в папке с файлом «Тут макрос» (у него название можно менять) и быть ЗАКРЫТ на момент запуска макроса (можно исправить)

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

Тут макрос.xlsb (17.39 КБ)

Изменено: Jack Famous — 28.05.2021 10:10:27

Иван Ж

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

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

#11

28.05.2021 20:40:09

Jack Famous, спасибо! То, что нужно!
Отдельно спасибо, за комментарии в коде, это всегда важно (особенно новичкам в VBA).
Функция с открытием файла довольно удобная (записал для себя). Заметил только одну проблему, с таким кодом и расположением в одной папке не работает. Ругается, что не нашел файл. Не знаю, в чем ошибка.
Скорректировал немного код, теперь ок.

Код
Workbooks.Open Filename:=ThisWorkbook.Path & "Книга2.xlsx"

Остался один момент, я заранее не уточнил. Связан с предыдущим пунктом:

Цитата
Jack Famous написал: быть ЗАКРЫТ на момент запуска макроса (можно исправить)

Что необходимо заменить для сбора данных из открытого (буду открывать сам) файла «Книга2»? Т.к. иногда необходимо оперативно что-то поменять, получается не всегда удобно открывать/закрывать файл для запуска макроса.

Jack Famous

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

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

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Иван Ж, вопрос не по теме
Установите пропуск ошибок On Error Resume Next перед открытием файла, откройте, сбросьте пропуск ошибок On Error GoTo 0 и проверьте, является активная книга открываемым файлом (по полному пути)
Можно и просто отключить оповещения (может и так придется добавить), т.к. открытие открытого вызывает оповещения, а не ошибку, но не так может пойти что-то ещё и так надёжнее

Иван Ж

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

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

#13

29.05.2021 20:25:58

Цитата
Jack Famous написал: вопрос не по теме

Я про то, что макрос, при считывании данных, берет их из активной книги, а не через условие типа:

Код
wb2 = Workbooks("Книга2.xlsx") arr = wb2.Sheets(1).Range("B2:E" & n).Value2

и предположил, что фраза «можно исправить» именно на это и намекает

Цитата
Jack Famous написал: быть ЗАКРЫТ на момент запуска макроса (можно исправить)

Итого. Как и писал ранее, макрос работает отлично, еще раз большое спасибо!
«Проблему» необходимость держать файл закрытым обошел тем, что заменил строки «открыть/закрыть файл» строками активировать «книгу2″/активировать книгу с макросом.

Изменено: Иван Ж — 29.05.2021 20:26:08

Иван Ж

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

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

#14

03.06.2021 22:55:30

Столкнулся с еще одной проблемой, не продумал это сразу..:
Если скрыть данные в «Книга2» (фильтром/скрытием строк/др. способом), то макрос застревает с ошибкой на строке

Код
If dic.Count = 0 Then Err.Raise xlErrNA

Для сравнения попробовал скрыть данные только в файле «Тут макрос» — ничего не изменилось, макрос выполнил свою задачу правильно.
Три вопроса (последний самый главный):
1) почему так получается
2) какая строка кода за это отвечает
3) как это исправить (нужна возможность скрывать данные)

Jack Famous

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

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

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Иван Ж, n (последняя строка/столбец) для обоих книг определяется методом «прыжка» (Ctrl+Arrows), а он не видит скрытые, получается словарь из закрытой книги не создаётся (нет данных), а для этого случая я написал вызов ошибки (Err.Raise xlErrNA), т.к. вы не писали, как это обходить надо и что делать
Не уверен, что при скрытии контрольной строки в книге с макросом отработает нормально, но принцип вы поняли
Чем заменить? Вот

тут

почитайте про метод определения с помощью ActiveSheet.UsedRange

Иван Ж

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

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

#16

27.07.2021 22:55:37

Цитата
Jack Famous написал: Вот тут почитайте про метод определения с помощью ActiveSheet.UsedRange

Еще раз спасибо за совет и ссылку.
UsedRange действительно помог решить проблему с фильтрацией. Контрольная строка не скрывается, т.ч. в этом место что-то изменять не потребовалось.

Источник

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

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

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

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

я так понял..

Источник