Координатное выделение
У вас большой монитор, но таблицы, с которыми вы работаете - еще больше. И, пробегая взглядом по экрану в поисках нужной информации, всегда есть шанс "соскользнуть" взглядом на соседнюю строчку и посмотреть не туда. Я даже знаю людей, который для таких случаев постоянно держат недалеко от себя деревянную линейку, чтобы приложить ее к строке на мониторе. Технологии будущего!
А если при движении активной ячейки по листу будет подсвечиваться текущая строка и столбец? Своего рода координатное выделение примерно такого вида:
Поудобнее, чем линейка, правда?
Есть несколько способов разной сложности, чтобы реализовать такое. Каждый способ - со своими плюсами и минусами. Давайте разберем их детально.
Способ 1. Очевидный. Макрос, выделяющий текущую строку и столбец
Самый очевидный путь для решения нашей проблемы "в лоб" - нам нужен макрос, который будет отслеживать изменение выделения на листе и выделять целую строку и столбец для текущей ячейки. Также желательно иметь возможность при необходимости включать и отключать эту функцию, чтобы такое крестообразное выделение не мешало нам вводить, например, формулы, а работало только тогда, когда мы просматриваем список в поисках нужной информации. Это приводит нас к трем макросам (выделения, включения и выключения), которые нужно будет добавить в модуль листа.
Откройте лист со таблицей, в которой хотите получить такое координатное выделение. Щелкните правой кнопкой мыши по ярлычку листа и выберите в контекстном меню команду Исходный текст (Source Code). Должно открыться окно редактора Visual Basic. Скопируйте в него этот текст этих трех макросов:
Dim Coord_Selection As Boolean 'глобальная переменная для вкл/выкл выделения
Sub Selection_On() 'макрос включения выделения
Coord_Selection = True
End Sub
Sub Selection_Off() 'макрос выключения выделения
Coord_Selection = False
End Sub
'основная процедура, выполняющая выделение
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WorkRange As Range
If Target.Cells.Count > 1 Then Exit Sub 'если выделено больше 1 ячейки - выходим
If Coord_Selection = False Then Exit Sub 'если выделение выключено - выходим
Application.ScreenUpdating = False
Set WorkRange = Range("A6:N300") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
Измените адрес рабочего диапазона на свой - именно в пределах этого диапазона и будет работать наше выделение. Затем закройте редактор Visual Basic и вернитесь в Excel.
Нажмите сочетание клавиш ALT+F8, чтобы открыть окно со списком доступных макросов. Макрос Selection_On, как нетрудно догадаться, включает координатное выделение на текущем листе, а макрос Selection_Off - выключает его. В этом же окне, нажав кнопку Параметры (Options) можно назначить этим макросам сочетания клавиш для удобного запуска.
Плюсы этого способа:
- относительная простота реализации
- выделение - операция безобидная и никак не изменяет содержимое или форматирование ячеек листа, все остается как есть
Минусы этого способа:
- такое выделение некорректно работает в том случае, если на листе есть объединенные ячейки - выделяются сразу все строки и столбцы, входящие в объединение
- если случайно нажать клавишу Delete, то очистится не только активная ячейка, а вся выделенная область, т.е. удалятся данные из всей строки и столбца
Способ 2. Оригинальный. Функция ЯЧЕЙКА + Условное форматирование
Этот способ хотя и имеет пару недостатков, мне представляется весьма изящным. Реализовать что-либо, используя только встроенные средства Excel, минимально влезая в программирование на VBA - высший пилотаж ;)
Способ основан на использовании функции ЯЧЕЙКА (CELL), которая может выдавать массу различной информации по заданной ячейке - высоту, ширину, номер строки-столбца, числовой формат и т.д.. Эта функция имеет два аргумента:
- кодовое слово для параметра, например "столбец" или "строка"
- адрес ячейки, для которой мы хотим определить значение этого параметра
Хитрость в том, что второй аргумент не является обязательным. Если он не указан, то берется текущая активная ячейка.
Вторая составляющая этого способа - условное форматирование. Эта крайне полезная функция Excel позволяет автоматически форматировать ячейки, если они удовлетворяют заданным условиям. Если соединить эти две идеи в одно целое, то получим следующий алгоритм реализации нашего координатного выделения через условное форматирование:
- Выделяем нашу таблицу, т.е. те ячейки, в которых в будущем должно отображаться координатное выделение.
- В Excel 2003 и более старших версиях открываем меню Формат - Условное форматирование - Формула (Format - Conditional Formatting - Formula). В Excel 2007 и новее - жмем на вкладке Главная (Home) кнопку Условное форматирование - Создать правило (Conditional Formatting - Create Rule) и выбираем тип правила Использовать формулу для определения форматируемых ячеек (Use formula)
- Вводим формулу для нашего координатного выделения:
=ИЛИ(ЯЧЕЙКА("строка")=СТРОКА(A2);ЯЧЕЙКА("столбец")=СТОЛБЕЦ(A2))
=OR(CELL("row")=ROW(A1),CELL("column")=COLUMN(A1))
Эта формула проверяет, не совпадает ли номер столбца каждой ячейки в таблице с номером столбца текущей ячейки. Аналогично со столбцами. Таким образом закрашенными окажутся только те ячейки, у которых либо номер столбца, либо номер строки совпадает с текущей ячейкой. А это и есть крестообразное координатное выделение, которого мы хотим добиться. - Нажмите кнопку Формат (Format) и задайте цвет заливки.
Все почти готово, но остался один нюанс. Дело в том, что Excel не считает изменение выделения изменением данных на листе. И, как следствие, не запускает пересчет формул и перекраску условного форматирования только при изменении положения активной ячейки. Поэтому добавим в модуль листа простой макрос, который будет это делать. Щелкните правой кнопкой мыши по ярлычку листа и выберите в контекстном меню команду Исходный текст (Source Code). Должно открыться окно редактора Visual Basic. Скопируйте в него этот текст этого простого макроса:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveCell.Calculate
End Sub
Теперь при изменении выделения будет запускаться процесс пересчета формулы с функцией ЯЧЕЙКА в условном форматировании и заливаться текущая строка и столбец.
Плюсы этого способа:
- Условное форматирование не нарушает пользовательское форматирование таблицы
- Этот вариант выделения корректно работает с объединенными ячейками.
- Нет риска удалить целую строку и столбец с данными при случайном нажатии Delete.
- Макросы используются минимально
Минусы этого способа:
- Формулу для условного форматирования надо вводить вручную.
- Нет быстрого способа включить-выключить такое форматирование - оно включено всегда, пока не будет удалено правило.
Способ 3. Оптимальный. Условное форматирование + макросы
Золотая середина. Используем механизм отслеживания выделения на листе при помощи макросов из способа-1 и добавим к нему безопасное выделение цветом с помощью условного форматирования из способа-2.
Откройте лист со таблицей, в которой хотите получить такое координатное выделение. Щелкните правой кнопкой мыши по ярлычку листа и выберите в контекстном меню команду Исходный текст (Source Code). Должно открыться окно редактора Visual Basic. Скопируйте в него этот текст этих трех макросов:
Dim Coord_Selection As Boolean
Sub Selection_On()
Coord_Selection = True
End Sub
Sub Selection_Off()
Coord_Selection = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WorkRange As Range, CrossRange As Range
Set WorkRange = Range("A7:N300") 'адрес рабочего диапазона с таблицей
If Target.Count > 1 Then Exit Sub
If Coord_Selection = False Then
WorkRange.FormatConditions.Delete
Exit Sub
End If
Application.ScreenUpdating = False
If Not Intersect(Target, WorkRange) Is Nothing Then
Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
WorkRange.FormatConditions.Delete
CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
CrossRange.FormatConditions(1).Interior.ColorIndex = 33
Target.FormatConditions.Delete
End If
End Sub
Не забудьте изменить адрес рабочего диапазона на адрес своей таблицы. Закройте редактор Visual Basic и вернитесь в Excel. Чтобы использовать добавленные макросы, нажмите сочетание клавиш ALT+F8 и действуйте аналогично способу 1.
Способ 4. Красивый. Надстройка FollowCellPointer
Excel MVP Jan Karel Pieterse родом из Нидерландов раздает у себя на сайте бесплатную надстройку FollowCellPointer(36Кб), которая решает ту же задачу, отрисовывая с помощью макросов графические линии-стрелки для подсветки текущей строки и столбца:
Красивое решение. Не без глюков местами, но попробовать точно стоит. Качаем архив, распаковываем на диск и устанавливаем надстройку:
- в Excel 2003 и старше - через меню Сервис - Надстройки - Обзор (Tools - Add-Ins - Browse)
- в Excel 2007 и новее - через Файл - Параметры - Надстройки - Перейти - Обзор (File - Excel Options - Add-Ins - Go to - Browse)
Ссылки по теме
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error Resume Next Dim x As Range: Set x = Range("B5:BM5001"): x.Interior.ColorIndex = xlNone 'If Target.Count > 1 Then Exit Sub If Not Intersect(Target, x) Is Nothing Then Intersect(x, Target.EntireRow).Interior.Color = RGB(235, 247, 255) Intersect(x, Target.EntireColumn).Interior.Color = RGB(235, 247, 255) Target.Interior.ColorIndex = xlNone End If End SubДовольно удобный вариант!
Option Explicit
Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pColorStruct As ColorStruct) As Long
Private Const CC_RGBINIT = &H1
Private Type ColorStruct
lStructSize As LongPtr
hwndOwner As LongPtr
hInstance As LongPtr
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
Function ShowColor(Optional lngColor As Long) As Long
Dim cc As ColorStruct
Dim CustomColors() As Byte
Dim i As Integer
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
'set the structure size
cc.lStructSize = Len(cc)
'Set the owner
cc.hwndOwner = Application.Hwnd
'set the application's instance
cc.hInstance = 0
'set the custom colors (converted to Unicode)
cc.lpCustColors = StrConv(CustomColors, vbUnicode)
'no extra flags
cc.flags = CC_RGBINIT
'set color
cc.rgbResult = lngColor
'Show the 'Select Color'-dialog
If ChooseColor(cc) <> 0 Then
ShowColor = cc.rgbResult
'CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
Else
ShowColor = -1
End If
End Function
Dim Coord_Selection As Boolean Sub Selection_On() Coord_Selection = True End Sub Sub Selection_Off() Coord_Selection = False End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim WorkRange As Range [COLOR=#ee1d24] If Target.Cells.Count > 1 Then Exit Sub[/COLOR] If Coord_Selection = False Then Exit Sub Application.ScreenUpdating = False Set WorkRange = Range("A1:CA500";) Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select Target.Activate End Subчто делать?
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim WorkRange As Range On Error GoTo GetOut If Target.Cells.Count > 1 Then Exit Sub If Coord_Selection = False Then Exit Sub Application.ScreenUpdating = False Set WorkRange = Range("A1:CA500") Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select Target.Activate GetOut: End SubМаксим.
=ИЛИ(И(ЯЧЕЙКА("строка")=СТРОКА(A2);ЯЧЕЙКА("столбец")<>СТОЛБЕЦ(A2));И(ЯЧЕЙКА("строка")<>СТРОКА(A2);ЯЧЕЙКА("столбец")=СТОЛБЕЦ(A2)))
Также Excel 2007 не пересчитывает только активную ячейку (ActiveCell.Calculate), по крайней мере, у меня, а пересчитывает всю книгу, что при большом объеме вычислений, создает "тормоза". Пришлось заменить на пересчет текущего листа (ActiveSheet.Calculate).
Подскажите пожалуйста, как поправить вашу формулу, чтоб она работала только на строку? Заранее спасибо.
=И(ЯЧЕЙКА("строка")=СТРОКА(A1);ЯЧЕЙКА("столбец")<>СТОЛБЕЦ(A1))У меня ни один из способов (кроме 4) не сработал. Может это быть из-за того,что английская версия установлена?!
Мне нужно, чтобы столбец выделялся цветом на текущую дату.
Спасибо.
Вопрос: возможен-ли третий вариант не удаляющий всё, ранее установленное, условное форматирование со всего целевого диапазона ?
При этом сохраняется возможность отката действий. Не меняется форматирование, И, поскольку задействован ТОЛЬКО видимый диапазон, работает очень быстро.
2. Проблема: если есть объединённые ячейки, то выделяет все строки и столбцы, что входят в диапазон объединённых ячеек.
Из плюсов способа только то, что не надо задавать диапазоны и возможность отмены действий.
=И($A$2<>"";ИЛИ(ЯЧЕЙКА("строка")=СТРОКА(A2);ЯЧЕЙКА("столбец")=СТОЛБЕЦ(A2)))
В данном случае ячейка A2 ячейка служит переключателем.
Если в A2 что-то ввели (даже пробел), то крест работает, если удалили, то не работает
можно задать любую другую ячейку переключателем $F$1 например
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveCell.Calculate
End Sub
возможно ли включить только условное форматирование без печесчета всей книги?
А то при перемещении с клавиатуры тормозит очень.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Areas.Count = 1 And .Rows.Count = 1 And Names("s.hgt") <> "=" & .Row Then Names("s.hgt").Value = .Row End With End SubПодскажите, можно ли с помощью 2 способа вместо выделения всего столбца и строки, выделять только верхнюю и крайнюю левую ячейки текущего столбца и строки?
и ещё такая
Подскажите, а как изменить макрос в способе 3, чтобы выделялась только строка?
Заранее спасибо!
использовать
Вопрос по первому варианту....
Если макрос выделения Вкл., и при этом перейти по любой гиперссылке, происходит ошибка: "Run-time error 1004" (скрин:
Подскажите как поправить?
Спасибо!
И все же что нужно поменять, что бы выделять только строки?
Заранее прошу прощения за потраченное время и благодарю за внимание!
Пример с OptionButton:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B1:J99")) Is Nothing Then Exit Sub ActiveCell.Calculate End Subесть
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveCell.Calculate
End Sub
работает выделение строк с усл фоматированием.
Как его можно отключать при желании.
Еще вопрос, может знаете.
Как позволить пользователю менять стиль выделения. Например пс привязкой к образцу в определенной ячейке.
Взял за основу третий способ, все работает супе! Но оказывается что при выполнения макроса удаляются все остальные правила форматирования(((. Ни как не могу решить проблему что бы макрос не удалял другие правила.
Прошу Вас помочь в данном вопросе)))
Заранее спасибо!
Dim Coord_Selection As Boolean
Sub Selection_On()
Coord_Selection = True
Application.OnKey "{DEL}", ""
Application.OnKey "^{c}", ""
Application.OnKey "^{v}", ""
Application.OnKey "^{x}", ""
Application.CutCopyMode = False
End Sub
Sub Selection_Off()
Coord_Selection = False
Application.OnKey "{DEL}"
Application.OnKey "^{c}"
Application.OnKey "^{v}"
Application.OnKey "^{x}"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WorkRange As Range
Dim wi As Window
Set wi = ActiveWindow
If Target.Cells.Count > 1 Then Exit Sub
If Coord_Selection = False Then Exit Sub
Application.ScreenUpdating = False
Set WorkRange = wi.VisibleRange
Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn)).Select
Target.Activate
End Sub
Вот небольшая модернизация кода, с защитой от "дурака" случайного копирования в выделенный "крест" и также удаление
Последний вариант кода работает отлично - то что мне нужно!
Подскажите, как изменить этот код, чтобы его разместить в модуле и чтобы он работал для всех страниц? Заранее благодарю!