Здравствуйте, уважаемые гуру Excel. Очень прошу Вас помочь подкорректировать макрос. Он работает, но не совсем так как задумано. Проблема в том, что он неправильно воспринимает даты с названий столбцов и потому работает некорректно. Если даты одного года, то проблем нет, но у меня большой разброс, дела 2015 года не закрываются, приходится их указывать, а макрос понимает нормально только один год. Короче разброс идет 5 лет максимум, начиная с 2015 г.(получается рабочая зона с K:BR) Суть макроса такова: закрашивание ячеек в зависимости от дат, которые расположены в столбце J, верхняя строка даты - начальная дата и по идее она закрашивает серым цветом ячейки до предыдущего месяца (если стоит 01.02.2016, то от начала столбца покроется серым цветом все до столбца "январь 2016"), вторая строка даты из столбца J закрашивает ячейки так: от серой ячейки 2 шага (белый цвет) после синий и до конечного месяца, последний месяц всегда синяя ячейка в не зависимости от того, что шаг собъётся. И последний момент, если в столбце H стоит значение ежемесячно, то ячейки становятся синими без шага, ежеквартально - с шагом. Сейчас есть ошибки, взять даже первую строку дата стоит с 2016-2017 годы, а он начинает шаг с 2015. Для удобства выведена кнопка "белым" для закрашивания всей рабочей зоны белым цветом. Тема создана на другом сайте, но там никто пока не помог http://www.planetaexcel.ru/forum....ot-daty
Здравствуйте, уважаемые гуру Excel. Очень прошу Вас помочь подкорректировать макрос. Он работает, но не совсем так как задумано. Проблема в том, что он неправильно воспринимает даты с названий столбцов и потому работает некорректно. Если даты одного года, то проблем нет, но у меня большой разброс, дела 2015 года не закрываются, приходится их указывать, а макрос понимает нормально только один год. Короче разброс идет 5 лет максимум, начиная с 2015 г.(получается рабочая зона с K:BR) Суть макроса такова: закрашивание ячеек в зависимости от дат, которые расположены в столбце J, верхняя строка даты - начальная дата и по идее она закрашивает серым цветом ячейки до предыдущего месяца (если стоит 01.02.2016, то от начала столбца покроется серым цветом все до столбца "январь 2016"), вторая строка даты из столбца J закрашивает ячейки так: от серой ячейки 2 шага (белый цвет) после синий и до конечного месяца, последний месяц всегда синяя ячейка в не зависимости от того, что шаг собъётся. И последний момент, если в столбце H стоит значение ежемесячно, то ячейки становятся синими без шага, ежеквартально - с шагом. Сейчас есть ошибки, взять даже первую строку дата стоит с 2016-2017 годы, а он начинает шаг с 2015. Для удобства выведена кнопка "белым" для закрашивания всей рабочей зоны белым цветом. Тема создана на другом сайте, но там никто пока не помог http://www.planetaexcel.ru/forum....ot-datygizon
Sub cveta() Dim lngI As Long Dim lngJ As Long Dim arrS() As String For lngI = 2 To Cells(Rows.Count, 10).End(xlUp).Row 'от 2-ой до последней заполненной ячейке по столбцу J arrS = Split(Trim(Cells(lngI, 10)), " - " & Chr(10)) 'разделяем содержимое ячейки на 2 даты If Cells(lngI, 8) = "ежемесячно" Then 'проверяем наличие условия 'если да - то тупо красим в голубой все ячейки по строке от января до месяца из второй даты Cells(lngI, 10).Offset(0, 1).Resize(1, DateDiff("m", [k1], CDate(arrS(1))) + 1).Interior.ColorIndex = 37 Else 'если нет 'красим промежуток от столбца К до столбца месяца из первой даты в серый 'добавил проверку - если месяц первой даты - январь - не красим. Cells(lngI, 10).Offset(0, 1).Resize(1, DateDiff("m", [k1], CDate(arrS(0)))).Interior.ColorIndex = 15 For lngJ = DateDiff("m", [k1], CDate(arrS(0))) + 3 To DateDiff("m", [k1], CDate(arrS(1))) + 1 Step 3 Cells(lngI, 10 + lngJ).Interior.ColorIndex = 37 Next lngJ
Cells(lngI, 11 + DateDiff("m", [k1], CDate(arrS(1)))).Interior.ColorIndex = 37 End If Next lngI End Sub
[/vba]
Закрасить весь диапазон белым можно одной строчкой: [vba]
Код
Range("K2:BR27").Interior.ColorIndex = 2
[/vba]
еще вариант: [vba]
Код
Sub cveta() Dim lngI As Long Dim lngJ As Long Dim arrS() As String For lngI = 2 To Cells(Rows.Count, 10).End(xlUp).Row 'от 2-ой до последней заполненной ячейке по столбцу J arrS = Split(Trim(Cells(lngI, 10)), " - " & Chr(10)) 'разделяем содержимое ячейки на 2 даты If Cells(lngI, 8) = "ежемесячно" Then 'проверяем наличие условия 'если да - то тупо красим в голубой все ячейки по строке от января до месяца из второй даты Cells(lngI, 10).Offset(0, 1).Resize(1, DateDiff("m", [k1], CDate(arrS(1))) + 1).Interior.ColorIndex = 37 Else 'если нет 'красим промежуток от столбца К до столбца месяца из первой даты в серый 'добавил проверку - если месяц первой даты - январь - не красим. Cells(lngI, 10).Offset(0, 1).Resize(1, DateDiff("m", [k1], CDate(arrS(0)))).Interior.ColorIndex = 15 For lngJ = DateDiff("m", [k1], CDate(arrS(0))) + 3 To DateDiff("m", [k1], CDate(arrS(1))) + 1 Step 3 Cells(lngI, 10 + lngJ).Interior.ColorIndex = 37 Next lngJ
Cells(lngI, 11 + DateDiff("m", [k1], CDate(arrS(1)))).Interior.ColorIndex = 37 End If Next lngI End Sub
[/vba]
Закрасить весь диапазон белым можно одной строчкой: [vba]
Pelena, Manyasha, огромнейшее спасибо, нереально круто получилось. Всё протестировано, ошибок не выявлено, выбран вариант предложенный Pelenой. Можно, пожалуйста, попросить Вас ещё добавить линии границ к закрашенным ячейкам, так понятнее получается.
Pelena, Manyasha, огромнейшее спасибо, нереально круто получилось. Всё протестировано, ошибок не выявлено, выбран вариант предложенный Pelenой. Можно, пожалуйста, попросить Вас ещё добавить линии границ к закрашенным ячейкам, так понятнее получается.gizon