Есть файл, в котором постоянно меняются данные, которые берутся с другого листа, который я удалил. Данные на удаленном листе2 все в формате текстовом и на Лист1 в столбец "F" переносятся в формате ДАТА (пока не знаю как и если не разберусь, то создам еще одну тему). Очень хочется макросом "залить" цветами разными даты разных месяцев с столбце "F" и в столбце"G" по неделям сделать заливку разным цветом.. (мне нужна наглядность, когда заканчивается месяц или неделя. В принципе можно одним цветом заливать месяц через месяц и с неделями так же поступить..)
Есть файл, в котором постоянно меняются данные, которые берутся с другого листа, который я удалил. Данные на удаленном листе2 все в формате текстовом и на Лист1 в столбец "F" переносятся в формате ДАТА (пока не знаю как и если не разберусь, то создам еще одну тему). Очень хочется макросом "залить" цветами разными даты разных месяцев с столбце "F" и в столбце"G" по неделям сделать заливку разным цветом.. (мне нужна наглядность, когда заканчивается месяц или неделя. В принципе можно одним цветом заливать месяц через месяц и с неделями так же поступить..)ovechkin1973
можно заливать четные (или нечетные) недели и месяцы. В файле пример через УФ:
Спасибо! Интересное решение.. и вроде даже размер файла не увеличился. А как доработать формулы для УФ, чтобы заливал разными цветами (двумя) четные и нечетные месяца и недели.
можно заливать четные (или нечетные) недели и месяцы. В файле пример через УФ:
Спасибо! Интересное решение.. и вроде даже размер файла не увеличился. А как доработать формулы для УФ, чтобы заливал разными цветами (двумя) четные и нечетные месяца и недели.ovechkin1973
Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
Сообщение отредактировал ovechkin1973 - Суббота, 07.10.2017, 15:10
Sub Raskraska() Dim x, i&, j&, s&, TmpS&, dtEnd As Date Dim bu As Boolean
x = Range("F1", Cells(Rows.Count, 6).End(xlUp)(2, 1)).Value dtEnd = x(UBound(x) - 1, 1) For i = 2 To UBound(x) s = DateDiff("ww", x(i, 1), dtEnd, vbMonday, vbUseSystem) If TmpS <> s Then If bu Then Cells(j, 1).Resize(i - j, 13).Interior.Color = 15853276 j = i TmpS = s bu = Not bu End If Next i End Sub
Sub Raskraska() Dim x, i&, j&, s&, TmpS&, dtEnd As Date Dim bu As Boolean
x = Range("F1", Cells(Rows.Count, 6).End(xlUp)(2, 1)).Value dtEnd = x(UBound(x) - 1, 1) For i = 2 To UBound(x) s = DateDiff("ww", x(i, 1), dtEnd, vbMonday, vbUseSystem) If TmpS <> s Then If bu Then Cells(j, 1).Resize(i - j, 13).Interior.Color = 15853276 j = i TmpS = s bu = Not bu End If Next i End Sub
Интересное решение.. и вроде даже размер файла не увеличился. А как доработать формулы для УФ, чтобы заливал разными цветами (двумя) четные и нечетные месяца и недели.
Интересное решение.. и вроде даже размер файла не увеличился. А как доработать формулы для УФ, чтобы заливал разными цветами (двумя) четные и нечетные месяца и недели.
Sub Raskraska() Dim x, i&, j&, s&, k&, TmpS&, dtEnd As Date Dim bu As Boolean, buM As Boolean, TmpM& 'ActiveSheet.UsedRange.Interior.Color = xlNone' убрать всю заливку x = Range("F1", Cells(Rows.Count, 6).End(xlUp)(2, 1)).Value dtEnd = x(UBound(x) - 1, 1) For i = 2 To UBound(x) s = DateDiff("ww", x(i, 1), dtEnd, vbMonday, vbUseSystem) If TmpS <> s Then If bu Then Cells(j, 6).Resize(i - j).Interior.Color = 15853276 j = i TmpS = s bu = Not bu End If If TmpM <> Month(x(i, 1)) Then If buM Then Cells(k, 10).Resize(i - k).Interior.Color = 14408946 k = i TmpM = Month(x(i, 1)) buM = Not buM End If Next i End Sub
[/vba]
попробуйте так:
[vba]
Код
Sub Raskraska() Dim x, i&, j&, s&, k&, TmpS&, dtEnd As Date Dim bu As Boolean, buM As Boolean, TmpM& 'ActiveSheet.UsedRange.Interior.Color = xlNone' убрать всю заливку x = Range("F1", Cells(Rows.Count, 6).End(xlUp)(2, 1)).Value dtEnd = x(UBound(x) - 1, 1) For i = 2 To UBound(x) s = DateDiff("ww", x(i, 1), dtEnd, vbMonday, vbUseSystem) If TmpS <> s Then If bu Then Cells(j, 6).Resize(i - j).Interior.Color = 15853276 j = i TmpS = s bu = Not bu End If If TmpM <> Month(x(i, 1)) Then If buM Then Cells(k, 10).Resize(i - k).Interior.Color = 14408946 k = i TmpM = Month(x(i, 1)) buM = Not buM End If Next i End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
