Excel макрос выделенный текст

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

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

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

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)

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

  • Что такое макросы, куда вставлять код макроса на Visual Basic

Mehanik

1

27.12.2007, 18:03. Показов 13980. Ответов 5


Студворк — интернет-сервис помощи студентам

Необходимо найти нужный текст в одной из ячеек Excel — это просто,
Выделить ячейку, в которой находится искомый текст — это еще проще,
а вот как выделить всю строку, содержащею ячейку с искомым текстом — это я сделать не смог.
Если кто знает как, помогите!!!
Заранее спасибо.

Programming

Эксперт

94731 / 64177 / 26122

Регистрация: 12.04.2006

Сообщений: 116,782

27.12.2007, 18:03

Ответы с готовыми решениями:

Как выделить всю текущую строку в Excel?
как выделить всю текущую строку? Excel. если извесно, что в строке 5 ячеек? спасибо

По значению в ячейке выделить определённым цветом всю строку
Добрый вечер! Ну, пожалуйста, необходим макрос:
В определённом столбце(R) если значение в ячейке…

Макрос: выделить строку по значению ячейки А1
Добрый день.

Подскажите, как решить задачу:

В ячейке А1 введено значение 10
Как через макрос…

Ячейки, содержащие положительные числа, выделить голубым, отрицательные – красным, нулевые – зелёным (Excel)
28. Excel : В выделенном диапазоне все ячейки, содержащие положительные числа, выделить голубым…

5

0 / 0 / 0

Регистрация: 17.08.2007

Сообщений: 539

27.12.2007, 18:17

2

А еще зовешься Механиком! :-)

Rows(‘4:4’).Select — выделяет строку под номером 4

Вот тебе удочка: Tools->Macro->Record New Macro. Потом сделай все ручками и просмотри код записанного макроса.

Удачи!



0



Mehanik

09.01.2008, 09:03

3

Все замечательно, толькло маленький нюанс, я зарание не знаю координат ячейки.

AGZ

0 / 0 / 0

Регистрация: 12.08.2007

Сообщений: 7

10.01.2008, 13:21

4

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim sym_str As String
'Функция определяет адрес выделенной ячейки (ряд, столбец)
Public Sub SelAdr(r, c)
sym_str = Selection.Address(ReferenceStyle:=xlR1C1, _
    RowAbsolute:=True, ColumnAbsolute:=True)
SA r, c
End Sub
'Функция определяет адреса 2-х выделенных ячеек (ряд1, столбец1, ряд2, столбец2)
Public Sub Sel2Adr(r1, c1, r2, c2)
SelAdr r1, c1
SA r2, c2
End Sub
'Вспомогательная для SelAdr Sel2Adr
Public Sub SA(r, c)
Do
r = Val(sym_str)
sym_str = Right(sym_str, Len(sym_str) - 1)
Loop While r = 0
s = Trim(Str(r))
sym_str = Right(sym_str, Len(sym_str) - Len(s))
c = Val(sym_str)
s = Trim(Str(c))
sym_str = Right(sym_str, Len(sym_str) - Len(s))
End Sub



0



M.H.Cobra

0 / 0 / 0

Регистрация: 27.11.2007

Сообщений: 23

10.01.2008, 15:17

5

Если переменный диапазон то:

Visual Basic
1
ThisWorkbook.Sheets('Лист1').Range(Cells(1, 1), Cells(1, 10)).Select

а если именно всю строку,

Visual Basic
1
2
3
numstr = 4
mystr$ = numstr & ':' & numstr
ThisWorkbook.Sheets('Eeno1').Range(mystr).Select

Успехов.



0



3 / 3 / 0

Регистрация: 16.01.2008

Сообщений: 359

30.04.2008, 11:35

6

ну вы блин даете!!!! особенно прикольно смотриться алгоритм предложенный AGZ-ом.А все гораздо проще:
ActiveCell.EntireRow.Select — выделяет строку в которой находиться курсор ввода
Cells(5, 1).EntireRow.Select — выделяет пятую строку

тоже справедливо и для столбцов (EntireColumn)



1



Предположим, у вас большой набор данных, и вы хотите проверить определенное значение. Для этого вы можете использовать этот код. Когда вы запустите его, вы получите поле ввода для ввода значения для поиска.

Sub highlightValue()
Dim myStr As String
Dim myRg As Range
Dim myTxt As String
Dim myCell As Range
Dim myChar As String
Dim I As Long
Dim J As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count> 1 Then
myTxt= ActiveWindow.RangeSelection.AddressLocal
Else
myTxt= ActiveSheet.UsedRange.AddressLocal
End If
LInput: Set myRg= Application.InputBox("please select the data
range:", "Selection Required", myTxt, , , , , 8)
If myRg Is Nothing Then
Exit Sub
If myRg.Areas.Count > 1 Then
MsgBox"not support multiple columns" GoToLInput
End If
If myRg.Columns.Count <> 2 Then
MsgBox"the selected range can only contain two columns "
GoTo LInput
End If
For I = 0 To myRg.Rows.Count-1
myStr= myRg.Range("B1").Offset(I, 0).Value
With myRg.Range("A1").Offset(I, 0)
.Font.ColorIndex= 1
For J = 1 To Len(.Text)
Mid(.Text, J, Len(myStr)) = myStrThen
.Characters(J, Len(myStr)).Font.ColorIndex= 3
Next
End With
Next I
End Sub

Возможно вам это будет интересно!

2019-12-26

Привет, помогите разобраться с макросом для excel, нужно для работы.
Есть макрос:

Sub FindAndSelect()
   Dim strStartAddr As String ' Хранит координаты первого найденного значения
   Dim rgResult As Range

   ' Поиск первого входжения искомого слова
   Set rgResult = Range("A1:A10000").Find("слон", , xlValues)
   If Not rgResult Is Nothing Then
      ' Сохраним адрес найденной ячейки (чтобы контролировать зацикливание поиска)
      strStartAddr = rgResult.Address
   End If
   Do While Not rgResult Is Nothing
      ' Обработка результата поиска
      rgResult.Interior.Color = RGB(255, 255, 0)

      ' Новый поиск
      Set rgResult = Range("A1:A10000").FindNext(rgResult)
      If rgResult.Address = strStartAddr Then
         ' Поиск завершен
         Exit Do
      End If
   Loop
End Sub

Этот макрос ищет по столбцу А с 1 по 10000 строку, слово «слон» и выделяет ячейку цветом.
Мне бы хотелось его доработать так, чтобы макрос искал не одно слово «слон», а искал еще несколько слов, и закрашивал их разными цветами, к примеру: «слон» закрашивал красным, «белку» закрашивал зеленым, «шмеля» закрашивал серым.

Подскажите идеи для реализации этой задачи, спасибо.

Поиск и подсветка результатов в Excel

Макрос запрашивает строку для поиска, после чего ищет введенный текст в первом столбце листа, и подсвечивает результаты поиска.

При запуске макроса появляется диалоговое окно (InputBox), позволяющее задать текст для поиска.

Макрос подсвечивает красным цветом внутри ячейки текст, совпадающий с искомым
(+ выделяет найденное полужирным начертанием)

Перед началом поиска, цвет всех ячеек первого столбца сбрасывается (на черный)

Option Compare Text
 
Sub Find_n_Highlight()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$, v, pos&
    res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "диз")
    If VarType(res) = vbBoolean Then Exit Sub    ' нажата кнопка ОТМЕНА
    txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов

    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
    Application.ScreenUpdating = False
    ra.Font.Color = 0: ra.Font.Bold = 0  ' сброс цветового выделения

    For Each cell In ra.Cells    ' перебираем все ячейки
        pos = 1
        If cell.Text Like "*" & txt & "*" Then
            arr = Split(cell.Text, txt, , vbTextCompare)   ' разбивает текст ячейки на части
            If UBound(arr) > 0 Then    ' если подстрока найдена
                For Each v In arr    ' перебираем все вхождения
                    pos = pos + Len(v)    ' начальная позиция
                    With cell.Characters(pos, Len(txt))
                        .Font.ColorIndex = 3    ' выделяем цветом
                        .Font.Bold = True    ' и полужирным начертанием
                    End With
                    pos = pos + Len(txt)
                Next v
            End If
        End If
    Next cell
End Sub
  • 95126 просмотров

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Понравилась статья? Поделить с друзьями:
  • Excel макрос вывести сообщение
  • Excel макрос выбрать ячейки
  • Excel макрос выбрать файл
  • Excel макрос выбрать строку
  • Excel макрос выбрать столбец