Здравствуйте всем, мне создали макрос для выделения цветом заголовков в таблице, прошу помощи с одной проблемой в ней. Когда я выделяю несколько ячеек в таблице + за её пределами, то все эти цвета закрашивают захваченные ячейки (имееется ввиду, которые за пределами таблицы) и если случайно нажать на весь столбец или всю строку, там цвет до упора распространяется. Можно ли это исправить?
Здравствуйте всем, мне создали макрос для выделения цветом заголовков в таблице, прошу помощи с одной проблемой в ней. Когда я выделяю несколько ячеек в таблице + за её пределами, то все эти цвета закрашивают захваченные ячейки (имееется ввиду, которые за пределами таблицы) и если случайно нажать на весь столбец или всю строку, там цвет до упора распространяется. Можно ли это исправить?aghient
aghient, не самый лучший вариант цветового выделения. Наиболее быстрый вариант, на мой взгляд, для созданного макроса - поставить проверку, при которой, если выделенное кол-во ячеек равно кол-ву столбцов или кол-ву строк, выходить из макроса: [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim T As Range If Target.Count = Columns(1).Cells.Count Then Exit Sub If Target.Count = Rows(1).Cells.Count Then Exit Sub If Intersect(Range("C7:Q24"), Target) Is Nothing Then Range("C6:Q6").Interior.Pattern = xlNone Range("B7:Q24").Interior.Pattern = xlNone Exit Sub End If Range("B5:Q24").Interior.ColorIndex = xlNone For Each T In Target Target.Interior.ColorIndex = 15 Cells(T.Row, 2).Interior.ColorIndex = 37 Cells(6, T.Column).Interior.ColorIndex = 37 Next End Sub
[/vba] Но в этом случае макрос не будет выполняться, если общее кол-во выделенных ячеек будет равно 65536 или будет равно 256 (для файла в формате .xls). Правда эта правка спасёт только от выделения 1 столбца (строки), а если их будет несколько, то тут сразу надо резко резать общее кол-во выделяемых ячеек до 255 максимум (если мы хотим избежать этого и в случае выделения столбца и в случае выделения строки).
aghient, не самый лучший вариант цветового выделения. Наиболее быстрый вариант, на мой взгляд, для созданного макроса - поставить проверку, при которой, если выделенное кол-во ячеек равно кол-ву столбцов или кол-ву строк, выходить из макроса: [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim T As Range If Target.Count = Columns(1).Cells.Count Then Exit Sub If Target.Count = Rows(1).Cells.Count Then Exit Sub If Intersect(Range("C7:Q24"), Target) Is Nothing Then Range("C6:Q6").Interior.Pattern = xlNone Range("B7:Q24").Interior.Pattern = xlNone Exit Sub End If Range("B5:Q24").Interior.ColorIndex = xlNone For Each T In Target Target.Interior.ColorIndex = 15 Cells(T.Row, 2).Interior.ColorIndex = 37 Cells(6, T.Column).Interior.ColorIndex = 37 Next End Sub
[/vba] Но в этом случае макрос не будет выполняться, если общее кол-во выделенных ячеек будет равно 65536 или будет равно 256 (для файла в формате .xls). Правда эта правка спасёт только от выделения 1 столбца (строки), а если их будет несколько, то тут сразу надо резко резать общее кол-во выделяемых ячеек до 255 максимум (если мы хотим избежать этого и в случае выделения столбца и в случае выделения строки).Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Воскресенье, 22.01.2017, 13:48
[/vba] нужно T. ну и получается контроль области не помешает.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim T As Range If Intersect(Range("C7:Q24"), Target) Is Nothing Then Range("C6:Q6").Interior.Pattern = xlNone Range("B7:Q24").Interior.Pattern = xlNone Exit Sub End If Range("B5:Q24").Interior.ColorIndex = xlNone For Each T In Target If Not Intersect(Range("C7:Q24"), T) Is Nothing Then T.Interior.ColorIndex = 15 Cells(T.Row, 2).Interior.ColorIndex = 37 Cells(6, T.Column).Interior.ColorIndex = 37 End If Next End Sub
[/vba]
Ну и еще лучше способ ниже указан.
aghient, Просто там одна ошибка [vba]
Код
Target.Interior.ColorIndex = 15
[/vba] нужно T. ну и получается контроль области не помешает.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim T As Range If Intersect(Range("C7:Q24"), Target) Is Nothing Then Range("C6:Q6").Interior.Pattern = xlNone Range("B7:Q24").Interior.Pattern = xlNone Exit Sub End If Range("B5:Q24").Interior.ColorIndex = xlNone For Each T In Target If Not Intersect(Range("C7:Q24"), T) Is Nothing Then T.Interior.ColorIndex = 15 Cells(T.Row, 2).Interior.ColorIndex = 37 Cells(6, T.Column).Interior.ColorIndex = 37 End If Next End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim T As Range, RN As Range Application.ScreenUpdating = False Range("B5:Q24").Interior.ColorIndex = xlNone Set RN = Intersect(Range("C7:Q24"), Target) If RN Is Nothing Then Exit Sub For Each T In RN T.Interior.ColorIndex = 15 Cells(T.Row, 2).Interior.ColorIndex = 37 Cells(6, T.Column).Interior.ColorIndex = 37 Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim T As Range, RN As Range Application.ScreenUpdating = False Range("B5:Q24").Interior.ColorIndex = xlNone Set RN = Intersect(Range("C7:Q24"), Target) If RN Is Nothing Then Exit Sub For Each T In RN T.Interior.ColorIndex = 15 Cells(T.Row, 2).Interior.ColorIndex = 37 Cells(6, T.Column).Interior.ColorIndex = 37 Next Application.ScreenUpdating = True End Sub
aghient, действительно, надурил намудрил))). У Michael_S интересный и более правильный, наверное, вариант, поскольку проходимся только по ячейкам пересечения, а не по всей области выделения...
aghient, действительно, надурил намудрил))). У Michael_S интересный и более правильный, наверное, вариант, поскольку проходимся только по ячейкам пересечения, а не по всей области выделения...Roman777
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim RN As Range Application.ScreenUpdating = False Range("B5:Q24").Interior.ColorIndex = xlNone Set RN = Intersect(Range("C7:Q24"), Target) If RN Is Nothing Then Exit Sub RN.Interior.ColorIndex = 15 Range(Cells(RN.Row, 2), Cells(RN.Row + RN.Rows.Count - 1, 2)).Interior.ColorIndex = 37 Range(Cells(6, RN.Column), Cells(6, RN.Column + RN.Columns.Count - 1)).Interior.ColorIndex = 37 Application.ScreenUpdating = True End Sub
[/vba][vba][code][/code][/vba]
или так: [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim RN As Range Application.ScreenUpdating = False Range("B5:Q24").Interior.ColorIndex = xlNone Set RN = Intersect(Range("C7:Q24"), Target) If RN Is Nothing Then Exit Sub RN.Interior.ColorIndex = 15 Range(Cells(RN.Row, 2), Cells(RN.Row + RN.Rows.Count - 1, 2)).Interior.ColorIndex = 37 Range(Cells(6, RN.Column), Cells(6, RN.Column + RN.Columns.Count - 1)).Interior.ColorIndex = 37 Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
