Страницы: 1
RSS
VBA - закрасить все ячейки попадающих в несколько условий
 
Здравствуйте!
прошу помощи в составлении макроса для решения задача. Она состоит в том, чтобы закрасить все ячейки градиентом (в определенном диапазоне "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
 
Цитата
Иван Ж написал:
прошу помощи в составлении макроса
почему не называть все своими именами - сделать за вас)
Не бойтесь совершенства. Вам его не достичь.
 
Согласен с вам, правильнее было бы написать именно так. Т.к. на данный момент я не очень понимаю с чего нужно начать (как именно задать параметры и условия проверки).
У меня есть один простой макрос для закрашивания ячеек по условию (серый цвет ячеек "шапки"). Но основная проблема моей задачи заключается в том, что простой проверки по цвету ячейки/цвету шрифта недостаточно, нужна первоначальная проверка(поиск) нужной ячейки, а потом уже проверка по цвету.
Как это сделать - загадка для меня.
Код
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
 
Иван Ж, здравствуйте
1. не собирайте в один диапазон, а красоте прямо в цикле - так будет намного быстрее и кода меньше
2. RGB - это хоть и быстрая, но всё равно функция, так что запомните в лонг-переменную результат серого цвета и сравнивайте с переменной. Тем более, что и шрифт и фон одного цвета

Не понял, с чем у вас проблема - сформулируйте точнее и короче
Изменено: Jack Famous - 26.05.2021 22:15:18
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
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, надеюсь, что пойму. спасибо за совет!
 
Иван Ж, если вы вообще не понимаете в коде, то какой смысл городить такую пирамиду условий, если решение вы даже не поймёте
  1. Возьмите одно условие и по нему сделайте пример
  2. Опираться на цвет в качестве аргумента можно, но крайне рискованно — категорически не рекомендую
  3. Если прислушаетесь к п.2, и в качестве критериев будут значения, то решения будут намного проще, быстрее и стабильнее (это и заливки найденного качается)
Изменено: Jack Famous - 27.05.2021 09:20: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, почему лучше не применять в условиях поиска аргумент с заливкой?
(в своем примере я убрал это из условия и создал дополнительный столбец "проверки", а если этого сделать не получится, как поступить не используя заливку)
Изменено: Иван Ж - 27.05.2021 19:53:35
 
Иван Ж, почему значения лучше заливки:
  1. значения можно забрать с листа в массив и читать в оперативной памяти - это очень быстро
С заливкой, шрифтом, и прочими атрибутами ячейки, кроме значения, придется работать поячеечно - это долго
  2. групп оттенков любого цвета, которые человек не различит между собой очень много, а для Excel это будут разные цвета (он их легко различает)
Получается, у вас 30 оттенков заливки того, что вы хотите отнести к одной группе, а получите 30 групп или 1 из 30 или вообще ничего не получите
  3. привыкнув ориентироваться на значения, а не цвета, лишитесь множества проблем типа, как считать/суммировать по цвету фона/шрифта, а также не столкнутесь с проблемами и нюансами фильтрации по цветам

Завтра гляну ваши файлы
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
почему значения лучше заливки
Спасибо, понял!
Со вторым пунктом согласен вдвойне, т.к. столкнулся с аналогичной проблемой сам. Копировал ячейки с "одинаковыми" цветами из разных документов, потом долго искал причину "почему оно не работает". Сейчас если очень хочется поиграться с цветом, использую настройку RGB и одинаковые значения цифр.
 
Пробуйте
Файл "Книга2.xlsx" должен лежать в папке с файлом "Тут макрос" (у него название можно менять) и быть ЗАКРЫТ на момент запуска макроса (можно исправить)
Изменено: Jack Famous - 28.05.2021 10:10:27
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, спасибо! То, что нужно!
Отдельно спасибо, за комментарии в коде, это всегда важно (особенно новичкам в VBA).
Функция с открытием файла довольно удобная (записал для себя). Заметил только одну проблему, с таким кодом и расположением в одной папке не работает. Ругается, что не нашел файл. Не знаю, в чем ошибка.
Скорректировал немного код, теперь ок.
Код
Workbooks.Open Filename:=ThisWorkbook.Path & "\Книга2.xlsx"

Остался один момент, я заранее не уточнил. Связан с предыдущим пунктом:
Цитата
Jack Famous написал: быть ЗАКРЫТ на момент запуска макроса (можно исправить)
Что необходимо заменить для сбора данных из открытого (буду открывать сам) файла "Книга2"? Т.к. иногда необходимо оперативно что-то поменять, получается не всегда удобно открывать/закрывать файл для запуска макроса.
 
Иван Ж, вопрос не по теме
Установите пропуск ошибок On Error Resume Next перед открытием файла, откройте, сбросьте пропуск ошибок On Error GoTo 0 и проверьте, является активная книга открываемым файлом (по полному пути)
Можно и просто отключить оповещения (может и так придется добавить), т.к. открытие открытого вызывает оповещения, а не ошибку, но не так может пойти что-то ещё и так надёжнее
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
вопрос не по теме
Я про то, что макрос, при считывании данных, берет их из активной книги, а не через условие типа:
Код
wb2 = Workbooks("Книга2.xlsx")
arr = wb2.Sheets(1).Range("B2:E" & n).Value2
и предположил, что фраза "можно исправить" именно на это и намекает
Цитата
Jack Famous написал:
быть ЗАКРЫТ на момент запуска макроса (можно исправить)

Итого. Как и писал ранее, макрос работает отлично, еще раз большое спасибо!
"Проблему" необходимость держать файл закрытым обошел тем, что заменил строки "открыть/закрыть файл" строками активировать "книгу2"/активировать книгу с макросом.
Изменено: Иван Ж - 29.05.2021 20:26:08
 
Столкнулся с еще одной проблемой, не продумал это сразу..:
Если скрыть данные в "Книга2" (фильтром/скрытием строк/др. способом), то макрос застревает с ошибкой на строке
Код
If dic.Count = 0 Then Err.Raise xlErrNA
Для сравнения попробовал скрыть данные только в файле "Тут макрос" - ничего не изменилось, макрос выполнил свою задачу правильно.
Три вопроса (последний самый главный):
1) почему так получается
2) какая строка кода за это отвечает
3) как это исправить (нужна возможность скрывать данные)
 
Иван Ж, n (последняя строка/столбец) для обоих книг определяется методом "прыжка" (Ctrl+Arrows), а он не видит скрытые, получается словарь из закрытой книги не создаётся (нет данных), а для этого случая я написал вызов ошибки (Err.Raise xlErrNA), т.к. вы не писали, как это обходить надо и что делать
Не уверен, что при скрытии контрольной строки в книге с макросом отработает нормально, но принцип вы поняли
Чем заменить? Вот тут почитайте про метод определения с помощью ActiveSheet.UsedRange
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Вот  тут  почитайте про метод определения с помощью ActiveSheet.UsedRange
Еще раз спасибо за совет и ссылку.
UsedRange действительно помог решить проблему с фильтрацией. Контрольная строка не скрывается, т.ч. в этом место что-то изменять не потребовалось.
Страницы: 1
Наверх