Страницы: 1
RSS
Дублирование правил условного форматирования при копировании
 
Здравствуйте!
Часто сталкиваюсь со следующей проблемой:
Создаю правило условного форматирования для ячейки, потом копирую ячейку и правил на листе становится уже два. Сколько раз скопировал - столько и правил. А уж если к одной ячейке применено несколько условных форматирований...
Ну, думаю, вы поняли.

Есть ли возможность как-то побороться с этой бедой?
Возможно ли, чтобы одни и те же правила применялись
ко всему диапазону (в т.ч. несмежному)?

Спасибо!
Wo unrecht zu recht wird ist widerstand pflicht.
 
Цитата
mo8 написал:
Есть ли возможность как-то побороться с этой бедой?
при таком копировании - нет.
По вопросам из тем форума, личку не читаю.
 
mo8, здравствуйте
Чтобы не вставлять ВСЁ вставляйте ТОЛЬКО ЗНАЧЕНИЯ
Ад Условного Форматирования
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, благодарю за наводку!
В результате у меня получился рабочий макрос,
но проблема в том, что если на некоторых ячейках уже есть форматирование
(например, ячейки покрашены красным), то при срабатывании макроса это форматирование пропадает.
Существует ли возможность копировать/вставлять только условное форматирование?
Спасибо!

Вот как выглядит получившийся у меня макрос:
Код
Option Explicit

'Def - все переменные в нижеследующих сабах, начинающиеся с соответствующей буквы автоматически становятся заданного типа
DefBool O           '(Boolean) True (-1) or False (0)
DefByte B           '(Byte)  [1 байт] целые положительные от 0 до 255
DefInt I            '% (Integer) [2 байта] целые от -32768 до 32767
DefLng L            '& (Long) [4 байта] целые от -2'147'483'648 до 2'147'483'647
DefSng N            '! (Single) [4 байта] дробные от -3,402'823*10^38 до -1,401'298*10^-45 и от 1,401'298*10^-45 до 3,402'823*10^38
DefDbl E            '# (Double) -1.79769313486231E308 to -4.94065645841247E-324 for negative values; 4.94065645841247E-324 to 1.79769313486232E308 for positive values.
DefDate D           '(Date) [8 байт] дата и/или время
DefStr S            '$ [по 2 байта за символ] (String)
DefCur U            '@ [8 байт] (Currency) -922,337,203,685,477.5808 to 922,337,203,685,477.5807
DefObj J            'Object
DefVar V            'Variant
'DefLngPtr X         'LongPtr  integer on 32-bit systems: Signed 32-bit (4-byte) numbers ranging in value from -2,147,483,648 to 2,147,483,647 on 32-bit systems
'DefLngLng Y         'LongLong integer on 64-bit systems: Signed 64-bit (8-byte) numbers ranging in value from -9,223,372,036,854,775,808 to 9,223,372,036,854,775,807 on 64-bit systems

Sub Борьба_с_дублями_УФ()
Dim o_Экран
Dim L_номер_последней_заполненной_строки, L_якорь, L_строка
Dim i_Столбец
Dim rng_Весь_диапазон As Range, rng_Исходная_Строка As Range, rng_Строка2 As Range, rng_Очищаемый_диапазон As Range
o_Экран = Application.ScreenUpdating                                                'приравнять переменную текущему стаутсу обновления экрана
Лист1.Activate                                                                      'активировать Лист1
If o_Экран = True Then Application.ScreenUpdating = False                           'если обновление экрана включено, то выключить обновление экрана
    With ActiveSheet
        L_строка = ActiveCell.Row: i_Столбец = ActiveCell.Column                    'определить координаты текущей активной ячейки
        L_якорь = ActiveWindow.ScrollRow                                            'определить самую верхнюю видимую строку (на текущем экране)
        L_номер_последней_заполненной_строки = .UsedRange.Cells(Rows.Count, "C").End(xlUp).Row 'определить номер последней строки в столбце C
        Set rng_Исходная_Строка = .Range(Cells(9, "A"), Cells(9, "R"))              'задать исходную (эталонную) строку
        Set rng_Весь_диапазон = .Range(Cells(9, "A"), Cells(L_номер_последней_заполненной_строки, "R")) 'задать весь диапазон
        Set rng_Очищаемый_диапазон = .Range(Cells(10, "A"), Cells(L_номер_последней_заполненной_строки, "R")) 'задать диапазон, на котором может стоять "лишнее" УФ
        rng_Очищаемый_диапазон.FormatConditions.Delete                              'удалить форматы с диапазона, к которому будет применяться УФ (кроме эталонной строки)
        rng_Исходная_Строка.Copy                                                    'копировать форматы из исходной (эталонной) строки
        rng_Весь_диапазон.PasteSpecial Paste:=xlPasteFormats                        'вставить форматы
        Application.CutCopyMode = False                                             'убрать копирование
        ActiveSheet.PageSetup.PrintArea = .Range(Cells(1, 1), Cells(L_номер_последней_заполненной_строки, "R")).Address 'задать область печати
        .Cells(L_строка, i_Столбец).Select                                          'активировать ячейку, которая была активна изначально
        ActiveWindow.ScrollRow = L_якорь                                            'открутить экран по вертикали до первоначального положения
    End With
Application.ScreenUpdating = o_Экран                                                'вернуть первоначачльный статус обновления экрана
End Sub
Wo unrecht zu recht wird ist widerstand pflicht.
 
Цитата
написал:
Существует ли возможность копировать/вставлять только условное форматирование?
Не могу ответить на вопрос буквально, однако если вставлять _только форматы_, то условное форматирование тоже будет вставлено, а формулы и значения - нет...
Страницы: 1
Читают тему (гостей: 1)
Наверх