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 |