Добрый вечер. При выполнении макроса от одна, или две, или три, или четыре ячейки окрашиваются в цвет согласно номеру пантона. При новом выполнении макроса , если были окрашены в предыдущий раз четыре ячейки, а в этот раз нужно только две, то третья и четвертая ячейка сохраняют окрас как после выполнения предыдущего макроса и сохраняют ненужную заливку цветом. Прошу подсказать, какой командой можно очистить заливку всех ячеек при каждом повторном выполнении макроса . Заранее спасибо. На прикрепленной фото видно, что 2 первых цвета вызваны выполнением макроса, а коричневый цвет остался после выполнения предыдущего, вот и вопрос как перед выполнением макроса очищать от предыдущих цветов ячейки
Прошу Вашей помощи
Добрый вечер. При выполнении макроса от одна, или две, или три, или четыре ячейки окрашиваются в цвет согласно номеру пантона. При новом выполнении макроса , если были окрашены в предыдущий раз четыре ячейки, а в этот раз нужно только две, то третья и четвертая ячейка сохраняют окрас как после выполнения предыдущего макроса и сохраняют ненужную заливку цветом. Прошу подсказать, какой командой можно очистить заливку всех ячеек при каждом повторном выполнении макроса . Заранее спасибо. На прикрепленной фото видно, что 2 первых цвета вызваны выполнением макроса, а коричневый цвет остался после выполнения предыдущего, вот и вопрос как перед выполнением макроса очищать от предыдущих цветов ячейки
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$12" Then If Target = Empty Then Exit Sub Range("A14:B20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If If Target.Address = "$D$12" Then If Target = Empty Then Exit Sub Range("D14:E20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If If Target.Address = "$G$12" Then If Target = Empty Then Exit Sub Range("G14:H20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If If Target.Address = "$J$12" Then If Target = Empty Then Exit Sub Range("J14:K20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If End Sub
[/vba]
Мой макрос такой:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$12" Then If Target = Empty Then Exit Sub Range("A14:B20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If If Target.Address = "$D$12" Then If Target = Empty Then Exit Sub Range("D14:E20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If If Target.Address = "$G$12" Then If Target = Empty Then Exit Sub Range("G14:H20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If If Target.Address = "$J$12" Then If Target = Empty Then Exit Sub Range("J14:K20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If End Sub
Добрый вечер. К сожалению файл по размеру не пройдет никак, к сожалению не смогу прикрепить. Я прикрепил фото, на котором видно, что ячейки окрашены, как можно у окрашенных ячеек перед выполнением макроса очистить свойства, а именно снять заливку цвета Какую команду нужно прописать в начале макроса, что бы она скидывала все предыдущие окрашивания ячеек до значения у цветных ячеек "нет заливки"
Добрый вечер. К сожалению файл по размеру не пройдет никак, к сожалению не смогу прикрепить. Я прикрепил фото, на котором видно, что ячейки окрашены, как можно у окрашенных ячеек перед выполнением макроса очистить свойства, а именно снять заливку цвета Какую команду нужно прописать в начале макроса, что бы она скидывала все предыдущие окрашивания ячеек до значения у цветных ячеек "нет заливки"artika2000
Добрый вечер, будьте добры, как получилось, я обрезал файл насколько можно с темой вопроса, не знаю как Вам это подойдет или нет. В любом случае спасибо Вам большое.
Объяснение на листе в файле
Добрый вечер, будьте добры, как получилось, я обрезал файл насколько можно с темой вопроса, не знаю как Вам это подойдет или нет. В любом случае спасибо Вам большое.
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
