Координатное выделение

У вас большой монитор, но таблицы, с которыми вы работаете - еще больше. И, пробегая взглядом по экрану в поисках нужной информации, всегда есть шанс "соскользнуть" взглядом на соседнюю строчку и посмотреть не туда. Я даже знаю людей, который для таких случаев постоянно держат недалеко от себя деревянную линейку, чтобы приложить ее к строке на мониторе. Технологии будущего! 

А если при движении активной ячейки по листу будет подсвечиваться текущая строка и столбец? Своего рода координатное выделение примерно такого вида:

coord_selection1.gif

Поудобнее, чем линейка, правда?

Есть несколько способов разной сложности, чтобы реализовать такое. Каждый способ - со своими плюсами и минусами. Давайте разберем их детально.

Способ 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 позволяет автоматически форматировать ячейки, если они удовлетворяют заданным условиям. Если соединить эти две идеи в одно целое, то получим следующий алгоритм реализации нашего координатного выделения через условное форматирование:

  1. Выделяем нашу таблицу, т.е. те ячейки, в которых в будущем должно отображаться координатное выделение.
  2. В Excel 2003 и более старших версиях открываем меню Формат - Условное форматирование - Формула (Format - Conditional Formatting - Formula). В Excel 2007 и новее - жмем на вкладке Главная (Home) кнопку Условное форматирование - Создать правило (Conditional Formatting - Create Rule) и выбираем тип правила Использовать формулу для определения форматируемых ячеек (Use formula)
  3. Вводим формулу для нашего координатного выделения:

    =ИЛИ(ЯЧЕЙКА("строка")=СТРОКА(A2);ЯЧЕЙКА("столбец")=СТОЛБЕЦ(A2))
    =OR(CELL("row")=ROW(A1),CELL("column")=COLUMN(A1))

    coord_selection2.gif

    Эта формула проверяет, не совпадает ли номер столбца каждой ячейки в таблице с номером столбца текущей ячейки. Аналогично со столбцами. Таким образом закрашенными окажутся только те ячейки, у которых либо номер столбца, либо номер строки совпадает с текущей ячейкой. А это и есть крестообразное координатное выделение, которого мы хотим добиться.
  4. Нажмите кнопку Формат (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Кб), которая решает ту же задачу, отрисовывая с помощью макросов графические линии-стрелки для подсветки текущей строки и столбца:

coord_selection3.gif

 

Красивое решение. Не без глюков местами, но попробовать точно стоит. Качаем архив, распаковываем на диск и устанавливаем надстройку:

  • в Excel 2003 и старше - через меню Сервис - Надстройки - Обзор (Tools - Add-Ins - Browse)
  • в Excel 2007 и новее - через Файл - Параметры - Надстройки - Перейти - Обзор (File - Excel Options - Add-Ins - Go to - Browse)

Ссылки по теме

 


Страницы: 1  2  
27.07.2016 17:43:02
Есть ли возможность использовать 4 способ на Excel x64? На сайте автора надстройка под него отсутствует.
Сам код надстройки открывается для редактирования, но к сожалению моих познаний для его корректировки не достаточно :(
02.10.2016 17:40:06
Здравствуйте Николай. Пользуюсь 3 способом, работает прекрасно, спасибо. Хотелось бы увидеть этот способ в надстройке PLEX. Вообще спасибо за Ваш сайт, очень много нашёл для себя полезного!!!
24.02.2017 22:08:46
Доброго дня!
Раз уж тут предлагали ряд альтернатив подобных решений...
Вот ещё одно координатное выделение:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = xlNone
With ActiveCell
    .EntireRow.Interior.ColorIndex = 40
    .EntireColumn.Interior.ColorIndex = 40
End With
End Sub
Правда стирает текущую заливку ячеек.
Николаю благодарность!
07.04.2017 21:35:28
Здравствуйте! Предлагаю свой способ подсветки строки без использования условного форматирования, который не удаляет существующие правила условного форматирования в таблице.
Цвет подсветки определяется цветом заливки ячейки А1. Если заливки в ячейке А1 нет, то подсветки строки таблицы с выделенной ячейкой не будет. В подсвечиваемой строке выделенная ячейка остается без заливки, если в ней не сработало условное форматирование, которое имеет приоритет во всех ячейках подсвечиваемой строки. При сохранении файла или активации другого листа подсветка строки убирается.  Подсветка столбца мне была не нужна, но ее несложно сделать аналогично подсветке строки, добавив еще один массив.

В модуль листа:
Private Sub Worksheet_Deactivate() 'если активируется другой лист и есть подсветка, то подсветка убирается
    Call restoreFill
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dataRng As Range ' диапазон данных таблицы
Dim rowRng As Range ' диапазон ячеек в строке таблицы для подсветки
Dim celRng As Range ' ячейки в диапазоне подсветки rowRng
Dim n As Integer
    Call restoreFill
    If Range("A1").Interior.ColorIndex = xlNone Then Exit Sub 'если подсветка отключена, то выход
    If Target.Count > 1 Then Exit Sub 'если выделено больше одной ячейки
    Set dataRng = Range(Cells(7, 2), Cells(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1, _
    ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1)) ' диапазон данных таблицы, Cells(7, 2) - адрес (начало) диапазона данных таблицы
    If Not Intersect(Target, dataRng) Is Nothing Then 'если ячейка выделена в диапазоне данных таблицы
        Set rowRng = Intersect(dataRng, Target.EntireRow) 'строка таблицы с выделенной ячейкой в диапазоне данных таблицы
        ReDim saveColor(rowRng.Cells.Count) 'размерность массива = ширина таблицы + нулевой элемент массива для адреса диапазона подсветки
        n = 0
        saveColor(n) = rowRng.Address 'адрес диапазона подсветки в нулевой элемент массива
        For Each celRng In rowRng 'перебор ячеек в диапазоне подсветки
            n = n + 1 'номер следующего элемента массива
            saveColor(n) = celRng.Interior.ColorIndex 'индекс заливки текущей ячейки в массив
        Next celRng
        rowRng.Interior.ColorIndex = Range("A1").Interior.ColorIndex 'заливка диапазона подсветки цветом заливки ячейки А1
        Target.Interior.ColorIndex = xlNone 'выделенная ячейка без заливки
    End If
    End Sub

Sub restoreFill() 'проверка включения подсветки, если подсветка была включена, то восстановление первоначальной (до подсветки) заливки в этой строке
Dim c As Integer
Dim cel_InRng As Range ' ячейки в диапазоне подсветки rowRng
    If (Not Not saveColor) <> 0 Then 'если массив не пустой (так проверяется массив, объявленный как Dim saveColor() ), т.е. диапазон подсветки был определен ранее
        c = 0
        For Each cel_InRng In Range(saveColor(0)) 'перебор ячеек в диапазоне, указанном в нулевом элементе массива
            c = c + 1 'номер следующего элемента массива
            cel_InRng.Interior.ColorIndex = saveColor(c) 'заливка ячеек цветами, сохраненными в массиве
        Next cel_InRng
        Erase saveColor 'удаление массива
    Else
        Exit Sub
    End If
End Sub
В модуль книги:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ActiveSheet.Name = "Имя листа с таблицей" Then Call Sheets("Имя листа с таблицей").restoreFill  
End Sub
В стандартный модуль:
Public saveColor() ' адрес подсвечиваемого диапазона и сохраненные цвета заливки подсвечиваемых ячеек таблицы до подсветки
Файл с примером
13.08.2019 12:18:50
Добрый день, Павел! Подскажите, как сделать дополнительно вертикальную подсветку столбца, Ваш вариант мне подошёл, но уже всю голову сломал как дописать Ваш код, выдаёт ошибку при попытках добавить весь массив с корректировками "Row" на "Column", наверняка делаю что-то не так, изучать VBA начал недавно, для пользования Экселя, пока что всех тонкостей ещё не постиг!
14.08.2019 10:39:35
И возникло ещё 2 проблемы:
1. Слабо подкрашенные ячейки меняют свой цвет
2. Любые изменения в файле теперь не откатить назад, сохраняется всегда последняя версия.
Если у вас есть мысли по этому поводу, с удовольствием бы их послушал и спасибо за Ваш труд!
18.06.2017 22:29:58
Спасибо, оч нужная вещь!
А можно 3 способ сделать на защищенном листе?
20.09.2017 10:36:03
Добрый день. Использовал 3 вариант, самый оптимальный и быстрый. Спасибо огромное. Однако родился такой вопрос как применить этот способ ко всей книге? а то у меня 20 листов в книге, а работает только на одном листе просто я выполняю этот макрос не через alt+f8  а через добавления пунктов в контекстное меню в дополнительном модуле

 Private Sub PopupMenuCreate() 'название макроса
    Dim bt As CommandBarControl 
    Set bt = Application.CommandBars("Cell").Controls.Add(before:=1) 
    bt.Caption = "Включить выделение": bt.OnAction = "Worksheet____3.Selection_On": bt.FaceId = 351 
    Dim bt1 As CommandBarControl 
    Set bt1 = Application.CommandBars("Cell").Controls.Add(before:=1) 
    bt1.Caption = "Выключить выделение": bt1.OnAction = "Worksheet____3.Selection_Off": bt1.FaceId = 352  
End Sub
и тут приходится напрямую указывать с какой странички берется макрос включения выключения.
Есть ли возможность сделать макрос который будет применим ко всей книге, а я через добавленные мною пункты смог бы просто включать и выключать выделение текста когда это нужно будет и на том листе на котором мне это будет нужно
13.10.2017 13:10:16
Воспользовался вторым способом.
Со строками все ок, а столбцы упорно не выделяются... что я не так могу делать.. формулу для условного форматирования просто копируюесли копировать =OR(CELL("row")=ROW(A1),CELL("column")=COLUMN(A1)) - выдает ошибку, что мол не соблюден синтаксис.
копирую чать для выделения  строк =OR(CELL("row")=ROW(A1)) - выделение строк работает
если оставляю часть для выделения столбцов=OR(CELL("column")=COLUMN(A1)) - не ругается но и не выделяет ничего

Есть идеи?
все эти варианты касаются таблиц, а как сделать подсветку столбца текущей (сегодняйшей) даты в диаграмме Ганта? Прошерстил вроде все но ответа не нашел. Буду благодарен всем кто откликнется
Добрый день. как в макросе (3 вариант) указать изменяющийся диапазон, например указать "умную таблицу"?
12.09.2019 14:26:35
Второй способ сохраняет возможность отмены последних действий и не удаляет существующие правила УФ, поэтому я выбираю его.
28.03.2020 15:02:05
Добрый день, способ 4 - супер!!!:) Спасибо Вам большое Николай, как всегда облегчаете нашу жизнь!:like:
22.05.2020 13:12:20
30.05.2020 14:07:54
Здравствуйте. А есть ли способ, чтобы выделялась именно активная ячейка, а не целиком строка/столбец?
25.09.2020 09:35:43
Настроил второй вариант. Работает только при дваойном нажатия, при обычном выделении не активируется?
08.01.2021 19:58:52
Приветствую!!!
использовал способ 2.
Выделил весь лист. "Крест" позиционируется на ячейку выше. Если в формуле поставить ссылку (А1), то активная ячейка совпадает с "крестом".

Помогите пожалуйста разобраться почему выбираем в формуле именно ссылку на ячейку (А2), а не  (А1) ?

Спасибо
01.03.2021 13:17:16
Добрый день!
Способ 4 хорош!
Но минус в том что перестаёт работать "Отмена действия" (Ctrl+Z)
Возможно уже есть решение, но я пока не нашёл...
07.03.2021 01:36:54
Может, кому пригодится:

Макрос, который можно сохранить в Личной книге макросов (Personal.xlsb), который записывает макрос автоматического пересчёта листа в 1-й лист в текущей книге:
Sub Vremja_2_chasa_nochi_a_ja_pishy_macros()
   Set objVBProj = ActiveWorkbook.VBProject
   Set objVBComp = objVBProj.VBComponents(Worksheets(1).CodeName)
' где Worksheets(1).CodeName - 1-й лист в книге, как бы он ни назывался  
   Set objCodeMod = objVBComp.CodeModule
' вставляем код
   With objCodeMod
      lLineNum = .CreateEventProc("SelectionChange", "Worksheet")
      lLineNum = lLineNum + 1
      .InsertLines lLineNum, "    ActiveCell.Calculate"
   End With 
End Sub
Безусловно, это возможно только если в настройках Экселя стоит галка "Доверять доступ к объектной модели VBA project"
Как это сделать, написано тут: Сайт Microsoft

Если кому-то нужно накатить макрос авто пересчёта на все листы в книге, то как это делать "автоматом" я не знаю )))
Единственная мысль - вот тут "Worksheets(1)" вместо (1) использовать переменную i и перебирать всю книгу в цикле i = i +1 до конца листов в ней "Worksheets(Worksheets.Count)". Или не так. Я в этом не понимаю.
12.03.2021 20:52:42
Можно ли поправить этот макрос, чтоб при выделении всего диапазона на листе не выходила ошибка?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range
    Set wi = ActiveWindow
    If Target.Cells.Count > 1 Then Exit Sub 
    
    Application.ScreenUpdating = False
    Set WorkRange = wi.VisibleRange 
    Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn)).Select
    Target.Activate

End Sub 
23.10.2021 21:29:26
Доброго времени суток! Помогите, пожалуйста! Есть таблица по социометрии, где по вертикали и горизонтали расположен список. Единичками отмечены выборы. Как автоматически или с  помощью условного форматирования подсветить взаимные выборы? Вручную выделила желтым цветом. Спасибо.
11.11.2021 17:54:16
Вопрос снимается.
05.02.2022 14:14:44
В старых версиях эксель такая функция была встроена.
01.04.2022 13:17:12
Есть ещё одна проблема при использовании координатного выделения: нельзя выделять весь лист, вылезает ошибка.
Проблема в этой строке:
If Target.Count > 1 Then Exit Sub 
с одной стороны она блокирует появление перекрестия при выделении больше одной ячейки, с другой стороны при выделении всего листа вылезает ошибка.
Лучше так:

On Error Resume Next   'при ошибке выполнит следующую процедуру
If Target.Count > 1 Then Exit Sub 
29.04.2022 12:15:47
Прошу простить, если не в тему, не знаю, как правильно воспользоваться поиском. Как сделать такую штуку. По Ctrl-F произвожу поиск и чтобы ячейка, в которой найдены данные, автоматически меняла фон на заданный? Смысл в том, что нужно при помощи сканера штрих-кодов прошерстить большую таблицу, выделяя те значения, которые внес в поле поиска. Каждый раз закрывать поиск, менять фон, снова закрывать поиск и искать следующую ячейку накладно при больших объемах.
27.10.2022 09:34:16
Подскажите пожалуйста, при использовании FollowCellPointer,  не дает отменить последнее действие, ни стрелочкой сверху слева, ни клавишами клавиш Ctrl+Z. В настройках FollowCellPointer ничего не нашел. Это у меня что  то не так?
28.06.2023 18:21:11
Добрый день.
Возможно ли что нибудь придумать что бы былы выделена цветом только 1 (одна) рабочая ячейка. Объясняю зачем. На 1 (одном) листе находится порядка 30 маленьких таблиц (3 столбца по 15 строк) и когда переводишь взгляд на программу с которой берёшь данные часто забываешь с какой таблицей работаешь и требуется время что бы понять в какой таблице на какой строчке в каком столбце остановился.
13.07.2023 21:20:59
Добрый день! Николай подскажи пожалуйста, что сдельть чтобы окрашенные ячейки этот макрос не очищал.
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 IfEnd Sub
Страницы: 1  2  
Наверх