Здравствуйте! прошу помощи в составлении макроса для решения задача. Она состоит в том, чтобы закрасить все ячейки градиентом (в определенном диапазоне "B3:G3") которые попадают под несколько условий: - закрашиваемая ячейка(книга1) имеет определенный цвет заливки (серый через RGB 161, 161, 161) - дата в столбце закрашиваемой ячейки(книга1) сходится с датой в строке проверяемой ячейки (книга2) - значение исходной ячейки(книга1) сходится со значением в строке проверяемой ячейки (книга2) - проверяемая ячейка (книга2) имеет определенный цвет шрифта (серый через RGB 161, 161, 161) Исходная ячейка (книга1) - "А2", сверяется со столбцом D (книга2)
Согласен с вам, правильнее было бы написать именно так. Т.к. на данный момент я не очень понимаю с чего нужно начать (как именно задать параметры и условия проверки). У меня есть один простой макрос для закрашивания ячеек по условию (серый цвет ячеек "шапки"). Но основная проблема моей задачи заключается в том, что простой проверки по цвету ячейки/цвету шрифта недостаточно, нужна первоначальная проверка(поиск) нужной ячейки, а потом уже проверка по цвету. Как это сделать - загадка для меня.
Код
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 написал: Не понял, с чем у вас проблема - сформулируйте точнее и короче
К сожалению, получилось не очень коротко, но я постарался более точно описать предполагаемый механизм работы/результата. На примере ячейки 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 написал: если вы вообще не понимаете в коде, то какой смысл городить такую пирамиду условий, если решение вы даже не поймёте
Не уверен, что я вас правильно понял. Условия, вроде-как, вполне ясные. На мой взгляд у меня проблема именно в составлении правильного-работающего кода, с последовательностью: цикл проверки - цикл вывода результата. Я постарался отразить то, что мне нужно в виде кода (ниже). Возможно, получился какой-то "несвязный бред", но уж.. на, что хватило опыта и понимания 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 - не равно "пусто" или <>""). Файлы дополнительно приложил.
А можно уточнить, для общего развития и понимания принципов работы VBA, почему лучше не применять в условиях поиска аргумент с заливкой? (в своем примере я убрал это из условия и создал дополнительный столбец "проверки", а если этого сделать не получится, как поступить не используя заливку)
Иван Ж, почему значения лучше заливки: 1. значения можно забрать с листа в массив и читать в оперативной памяти - это очень быстро С заливкой, шрифтом, и прочими атрибутами ячейки, кроме значения, придется работать поячеечно - это долго 2. групп оттенков любого цвета, которые человек не различит между собой очень много, а для Excel это будут разные цвета (он их легко различает) Получается, у вас 30 оттенков заливки того, что вы хотите отнести к одной группе, а получите 30 групп или 1 из 30 или вообще ничего не получите 3. привыкнув ориентироваться на значения, а не цвета, лишитесь множества проблем типа, как считать/суммировать по цвету фона/шрифта, а также не столкнутесь с проблемами и нюансами фильтрации по цветам
Завтра гляну ваши файлы
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: почему значения лучше заливки
Спасибо, понял! Со вторым пунктом согласен вдвойне, т.к. столкнулся с аналогичной проблемой сам. Копировал ячейки с "одинаковыми" цветами из разных документов, потом долго искал причину "почему оно не работает". Сейчас если очень хочется поиграться с цветом, использую настройку RGB и одинаковые значения цифр.
Option Explicit
'Option Private Module
'====================================================================================================
Sub Conditions()
Dim dic As New Dictionary
Dim x, arr, iNum&, t!, n&
t = Timer
iNum = Range("A2").Value2 ' запоминаем контрольное число (2253 в примере) из книги 1
Application.ScreenUpdating = False
Workbooks.Open Filename:="Книга2.xlsx", UpdateLinks:=False, ReadOnly:=True ' открываем файл (книга 2 в примере) если файл НЕ в папке с текущим, то прописывайте полный путь
n = Cells(Rows.Count, 2).End(xlUp).Row ' определяем последнюю строку с данными в столбце B
arr = Range("B2:E" & n).Value2 ' забираем в массив данные с B2:E2 и до последней строки
If Not IsArray(arr) Then Err.Raise xlErrNA
For n = 1 To UBound(arr, 1)
If Len(arr(n, 4)) Then ' если в столбце E есть данные …
If arr(n, 3) = iNum Then x = dic(arr(n, 1)) ' если в столбце D находится контрольное число, то запоминаем данные из столбца B в словарь
End If
Next n
ActiveWorkbook.Close False ' закрываем файл
Application.ScreenUpdating = True
If dic.Count = 0 Then Err.Raise xlErrNA
n = Cells(1, Columns.Count).End(xlToLeft).Column ' определяем последний столбец с данными в 1ой строке
arr = Cells(1, 2).Resize(1, n).Value2 ' забираем в массив данные из книги 1 (1я строка)
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Interior.ColorIndex = xlNone ' очищаем всю заливку
For n = 1 To UBound(arr, 2)
If dic.Exists(arr(1, n)) Then Cells(3, n + 1).Interior.Color = vbYellow ' если нашли совпадение, то красим в жёлтый
Next n
Application.ScreenUpdating = True
MsgBox "DONE", vbInformation, Format$(Timer - t, "0.00 sec")
End Sub
'====================================================================================================
Файл "Книга2.xlsx" должен лежать в папке с файлом "Тут макрос" (у него название можно менять) и быть ЗАКРЫТ на момент запуска макроса (можно исправить)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, спасибо! То, что нужно! Отдельно спасибо, за комментарии в коде, это всегда важно (особенно новичкам в VBA). Функция с открытием файла довольно удобная (записал для себя). Заметил только одну проблему, с таким кодом и расположением в одной папке не работает. Ругается, что не нашел файл. Не знаю, в чем ошибка. Скорректировал немного код, теперь ок.
Остался один момент, я заранее не уточнил. Связан с предыдущим пунктом:
Цитата
Jack Famous написал: быть ЗАКРЫТ на момент запуска макроса (можно исправить)
Что необходимо заменить для сбора данных из открытого (буду открывать сам) файла "Книга2"? Т.к. иногда необходимо оперативно что-то поменять, получается не всегда удобно открывать/закрывать файл для запуска макроса.
Иван Ж, вопрос не по теме Установите пропуск ошибок On Error Resume Next перед открытием файла, откройте, сбросьте пропуск ошибок On Error GoTo 0 и проверьте, является активная книга открываемым файлом (по полному пути) Можно и просто отключить оповещения (может и так придется добавить), т.к. открытие открытого вызывает оповещения, а не ошибку, но не так может пойти что-то ещё и так надёжнее
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
и предположил, что фраза "можно исправить" именно на это и намекает
Цитата
Jack Famous написал: быть ЗАКРЫТ на момент запуска макроса (можно исправить)
Итого. Как и писал ранее, макрос работает отлично, еще раз большое спасибо! "Проблему" необходимость держать файл закрытым обошел тем, что заменил строки "открыть/закрыть файл" строками активировать "книгу2"/активировать книгу с макросом.
Столкнулся с еще одной проблемой, не продумал это сразу..: Если скрыть данные в "Книга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 действительно помог решить проблему с фильтрацией. Контрольная строка не скрывается, т.ч. в этом место что-то изменять не потребовалось.