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

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

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

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)

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

 



04.02.2013 16:32:57
можно еще один вариант предложить (но у него большой минус - стирает залитые ячейки...):
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells.Interior.ColorIndex = xlNone
    With Selection
     .Resize(.Rows.Count).EntireRow.Interior.Color = RGB(204, 255, 153)
     .Resize(.Column).EntireColumn.Interior.Color = RGB(204, 255, 153)
    End With
End Sub
07.02.2013 00:51:59
Ну, вариант, конечно. Но заливать целиком строку (16 тыс. ячеек) и столбец (больше 1 млн. ячеек) - не есть гуд. Очень печально отразится на размере файла :(
08.05.2014 15:17:07
Здравствуйте Николай, заинтересовал вариант Способ 4. Красивый. Надстройка FollowCellPointer Возможно ли ее применить только для отдельной книги или для отдельного листа в книге?
08.05.2014 16:47:13
Надо лезть в код надстройки (если он не запаролен) и выдергивать оттуда функционал, привязав затем его к заданному листу.
01.03.2013 18:26:17
4-й вариант очень даже ничего. Спасибо большое Николай.
03.03.2013 08:46:39
Ну, спасибо, скорее, автору Jan Karel Pieterse :)
19.06.2013 14:49:09
Скажите, а можно ли обработчик события листа вставить в персональную книгу? То есть, чтобы макрос работал на любой открытой книге без необходимости конвертировать ее в xlsm и вставлять код в ее модуль?
02.07.2013 10:18:21
К сожалению, макросы обработки событий должны хранится не в персональной книге, а в модулях листов или книг, которые они отслеживают.
27.08.2013 11:40:27
Николай, примерно пол года, год назад скачал надстройку, которая работает как первый способ. Поэтому работает на всех книгах. Не могу к сожалению вспомнить где я ее брал, но могу выслать саму надстройку
Нужна помощь с координатным выделением. Идея такая - отслеживать с помощью координатного выделения обучение сотрудников по правилам промышленной безопасности, т.е. если дата в столбце с правилом приближается к окончанию срока действия обучения, то выделяестя как строка, так и столбец. Правил много - 8 столбцов, сотрудников еще больше - 250 строк. Как осуществить мою задачу с помощью макроса?
04.08.2013 16:35:38
Анастасия, координатное выделение и, тем более, макросы тут не нужны. Вполне достаточно будет обычного условного форматирования. Посмотрите тут.
15.08.2013 09:09:27
Вот еще вариант:

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 
нашел как-то здесь: http://www.programmersforum.ru/showpost.php?p=732649&postcount=5

Довольно удобный вариант!
29.08.2013 10:45:57
У меня макросы не пашут т.к. ругается что надо переделать их под x64. Что делать?
01.09.2013 09:43:44
Переустановить Office 32-bit. У вас очень многие макросы на 64-разрядном Office работать не будут :(
MEP
29.08.2013 11:59:29
При попытке выделения всего листа с помощью левого верхнего квадратика (пересечении букв-столбцов и цифр-строк) даже при выключенном маркосе. вылетает ошибка (выделил красным):
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

что делать?
02.09.2013 15:10:42
Перепишите Вашу процедуру так:
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
С уважением,
Максим.
05.09.2013 15:50:14
Вот вариант, который не стирает залитые ячейки. Вариант основан на Способе 2. Немного доработана формула и активная ячейка ("перекрестье прицела") остается без применения условного форматирования.

=ИЛИ(И(ЯЧЕЙКА("строка")=СТРОКА(A2);ЯЧЕЙКА("столбец")<>СТОЛБЕЦ(A2));И(ЯЧЕЙКА("строка")<>СТРОКА(A2);ЯЧЕЙКА("столбец")=СТОЛБЕЦ(A2)))

Также Excel 2007 не пересчитывает только активную ячейку (ActiveCell.Calculate), по крайней мере, у меня, а пересчитывает всю книгу, что при большом объеме вычислений, создает "тормоза". Пришлось заменить на пересчет текущего листа (ActiveSheet.Calculate).
17.09.2013 11:33:17
Отличная поправка, спасибо!
12.02.2018 17:40:41
Chainik-Samovar
Подскажите пожалуйста, как поправить вашу формулу, чтоб она работала только на строку? Заранее спасибо.
12.02.2018 21:40:52
Чтобы формула выделяла только строку, в ней надо оставить только вот это:
=И(ЯЧЕЙКА("строка")=СТРОКА(A1);ЯЧЕЙКА("столбец")<>СТОЛБЕЦ(A1))  
13.02.2018 11:44:32
Огромное спасибо. Все работает. Визуально очень удобно.
16.09.2013 12:31:12
Здравствуйте Николай, после применения "Способ 3. Оптимальный. Условное форматирование + макросы" перестают работать кнопки "отменить" и "вернуть", (т.е. они не активны) в чем может быть проблема?Офис 2013.Спасибо!
17.09.2013 11:32:50
Вячеслав, в любой версии Excel после выполнения макроса нельзя откатиться назад к предыдущим состояниям. А тут макрос как раз и используется.
23.09.2013 16:14:59
Добрый день!
У меня ни один из способов (кроме 4) не сработал. Может это быть из-за того,что английская версия установлена?!
Мне нужно, чтобы столбец выделялся цветом на текущую дату.

Спасибо.
30.10.2013 17:58:09
Скажите, а как в первом способе изменять цвет выделения?
18.11.2013 15:24:52
Добрый день! Вопрос: Почему при сохранени файла, макрос не сохраняется? Приходится заново вставлять макрос. А как можно сохранить, чтобы после открытия работало постоянно координатное выделение. Подскажите пожалуйста. У меня англ 2010 офис.
07.01.2014 15:34:26
Сохранять файл нужно в формате с поддержкой макросов (XLSM). Если сохраните просто как книгу Excel (XLSX), то все макросы умрут. Он, кстати, предупреждение об этом должен был выдавать при сохранении.
07.01.2014 06:12:49
Здоровские вещи !  Особенно 3-ий вариант с его "кнопками вкл/выкл"

Вопрос:   возможен-ли третий вариант не удаляющий всё, ранее установленное, условное форматирование со всего целевого диапазона ?
07.01.2014 15:32:52
Если найдете - напишите ;)
07.01.2014 16:53:10
Я не найду ))
07.01.2014 08:09:08
И ещё одна НЕ радость: на листе с макросом из способа 2  не удается копировать ячейки.  
19.01.2014 11:42:48
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  'если выделено больше 1 ячейки - выходим
 
    Application.ScreenUpdating = False
    Set WorkRange = wi.VisibleRange 'адрес рабочего диапазона, в пределах которого видно выделение
'    Intersect(WorkRange, Target.EntireRow).Select   'формируем строку диапазон и выделяем
    Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn)).Select 'формируем крестообразный диапазон и выделяем
    Target.Activate
End Sub

При этом сохраняется возможность отката действий. Не меняется форматирование, И, поскольку задействован ТОЛЬКО видимый диапазон, работает очень быстро.
11.02.2014 17:03:20
Добрый день! Подскажите  а возможно ли реализовать координатное выделение на диаграмме  по осям ?
25.06.2014 15:03:57
Николай, а как делать, что бы способ 3 работал при открывание файла?
10.09.2014 16:49:43
Способ 2 можно и "отключать":

=И($A$2<>"";ИЛИ(ЯЧЕЙКА("строка")=СТРОКА(A2);ЯЧЕЙКА("столбец")=СТОЛБЕЦ(A2)))

В данном случае ячейка A2 ячейка служит переключателем.
  Если в A2 что-то ввели (даже пробел), то крест работает, если удалили, то не работает
  можно задать любую другую ячейку переключателем $F$1 например
22.09.2014 11:59:24
Николай, по способу 2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   ActiveCell.Calculate
End Sub

возможно ли включить только условное форматирование без печесчета всей книги?
А то при перемещении с клавиатуры тормозит очень.
30.04.2017 15:27:36
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
И условное форматирование:
=СТРОКА()=s.hgt 
В диспетчере имён предварительно создать s.hgt  (или своё, разумеется)
04.01.2015 18:32:20
Николай, Вы виртуоз своего дела!

Подскажите, можно ли с помощью 2 способа вместо выделения всего столбца и строки, выделять только верхнюю и крайнюю левую ячейки текущего столбца и строки?
07.05.2015 09:36:18
Николай, подскажите пожалуйста, может ли макрос являться причиной не работы условного форматирования? Создаю правило условного форматирования, а оно тут же слетает
14.04.2016 21:04:06
в способе 3 есть строка
Target.FormatConditions.Delete
которая удаляет условное форматирование выделенной ячейки

и ещё такая
WorkRange.FormatConditions.Delete
которая удаляет форматирование (условное) с заданного интервала. Поэтому да, макрос может.
29.06.2015 10:15:56
Николай, добрый день!
Подскажите, а как изменить макрос в способе 3, чтобы выделялась только строка?
Заранее спасибо!
14.10.2015 11:36:10
Можно попробовать вместо строки:
Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))

использовать
Set CrossRange = Intersect(WorkRange, Target.EntireRow)
10.10.2015 15:03:13
Здравствуйте! А можно ли скопировать значение необходимой ячейки по названию строки и столбца и перенести в другую книгу?
14.10.2015 11:34:18
В смысле? Макросом?
07.11.2015 15:19:23
Очень простой и полезный способ №4. Но через 5 минут работы стал глючить =) И пошло смещение стрелок ( на 2-3 ячейки вверху )
26.11.2015 13:33:11
Здравствуйте! А можно в первом способе сделать без включения/выключения макроса, а так чтобы действовало всегда?
27.11.2015 13:48:34
Добрый день!
Вопрос по первому варианту....
Если макрос выделения Вкл., и при этом перейти по любой гиперссылке, происходит ошибка: "Run-time error 1004" (скрин: https://yadi.sk/i/oIyjKkx_kn7T5)
Подскажите как поправить?
Спасибо!
14.01.2016 15:16:14
Николай, доброго времени! Помогите дилетанту! Использовал способ 3 - очень помогло в работе,спасибо огромное! НО,,, решил попробовать настроить макрос так,что бы выделялись только строки,но не столбцы. Ессно ничего не получилось. Удалил текст макроса и вставил снова,а выделенные перед этим области так и остались выделенными. Удалил все правила с листа, выделение пропало, но теперь макрос на нужном листе не работает. Очень надеюсь на внимание!
И все же что нужно поменять, что бы выделять только строки?
Заранее прошу прощения за потраченное время и благодарю за внимание!
24.05.2016 23:18:32
=ЯЧЕЙКА("строка";)=СТРОКА(B1) условное форматирование из второго варианта. Работает выделение только строк. Включение-выключение выделения можно сделать при помощи формулы: =И($A$1="Вкл";ЯЧЕЙКА("строка";)=СТРОКА(B11)) . Можно создать выпадающий список в ячейке (в данном случае А1), состоящий из "Вкл" и "Откл". Можно привязать значение ячейки (в данном случае A1) к CheckBox'ам или OptionButton'ам. При этом форматирование ячеек не будет удаляться.

Пример с 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 Option_off_Click()
Cells(1, 1).Value = ""
End Sub

Private Sub Option_on_Click()
Cells(1, 1).Value = "Вкл"
End Sub
 
12.02.2016 11:13:00
класс.способ №3 как раз для моих слепых :D теток.Спасибо Николай!
17.03.2016 15:23:36
Добрый день Николай!
Взял за основу третий способ, все работает супе! Но оказывается что при выполнения макроса удаляются все остальные правила форматирования(((. Ни как не могу решить проблему что бы макрос не удалял другие правила.
Прошу Вас помочь в данном вопросе)))
Заранее спасибо!
01.06.2016 21:08:40

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

Вот небольшая модернизация кода, с защитой от "дурака" случайного копирования в выделенный "крест" и также удаление
Nat
19.07.2016 08:29:08
Добрый день!
Последний вариант кода работает отлично - то что мне нужно!
Подскажите, как изменить этот код, чтобы его разместить в модуле и чтобы  он работал для всех страниц? Заранее благодарю!
Nat
19.07.2016 08:28:28
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() ' адрес подсвечиваемого диапазона и сохраненные цвета заливки подсвечиваемых ячеек таблицы до подсветки
Файл с примером
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)) - не ругается но и не выделяет ничего

Есть идеи?
все эти варианты касаются таблиц, а как сделать подсветку столбца текущей (сегодняйшей) даты в диаграмме Ганта? Прошерстил вроде все но ответа не нашел. Буду благодарен всем кто откликнется
Наверх