Выделение активной ячейки, строки или столбца
В следующих примерах кода показаны способы выделения активной ячейки или строк и столбцов, содержащих активную ячейку. В этих примерах используется событие SelectionChange объекта Worksheet.
Пример кода предоставил: Том Уртис, Atlas Programming Management
Выделение активной ячейки
В следующем примере кода показано, как удалить цвет во всех ячейках листа, присвоив свойству ColorIndex значение 0, а затем выделить активную ячейку, присвоив свойству ColorIndex значение 8 (бирюзовый).
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = False ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 ' Highlight the active cell Target.Interior.ColorIndex = 8 Application.ScreenUpdating = True End Sub Выделение всей строки и столбца, содержащих активную ячейку
В следующем примере кода показано, как удалить цвет во всех ячейках листа, присвоив свойству ColorIndex значение 0, а затем выделить всю строку и столбец, содержащие активную ячейку, с помощью свойств EntireRow и EntireColumn.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 With Target ' Highlight the entire row and column that contain the active cell .EntireRow.Interior.ColorIndex = 8 .EntireColumn.Interior.ColorIndex = 8 End With Application.ScreenUpdating = True End Sub Выделение строки и столбца, содержащих активную ячейку, в текущей области
В следующем примере кода показано, как удалить цвет во всех ячейках листа, присвоив свойству ColorIndex значение 0, а затем в текущей области выделить строку и столбец, содержащие активную ячейку, используя свойство CurrentRegion объекта Range.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False With ActiveCell ' Highlight the row and column that contain the active cell, within the current region Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 8 Range(Cells(.CurrentRegion.Row, .Column), Cells(.CurrentRegion.Rows.Count + .CurrentRegion.Row - 1, .Column)).Interior.ColorIndex = 8 End With Application.ScreenUpdating = True End Sub Об участнике
Том Уртис, MVP — основатель компании Atlas Programming Management, создающей полноценные бизнес-решения для Microsoft Office и Excel в Кремниевой долине. Том обладает больше чем 25 годами опыта управления бизнесом и разработки приложений для Microsoft Office, а также является соавтором книги «Holy Macro! It’s 2,500 Excel VBA Examples».
Поддержка и обратная связь
Есть вопросы или отзывы, касающиеся Office VBA или этой статьи? Руководство по другим способам получения поддержки и отправки отзывов см. в статье Поддержка Office VBA и обратная связь.
Как выделить ячейки одного цвета и перенести их с сохранением позиции?
Нужно выделить ячейки одного цвета в столбце екселя, скопировать, и перенести в другой столбец. При этом, не нарушая порядок при копировании, например, если выделены ячейки a34, a35 и a37, то при копировании допустим в столбик b они вставлялись на то же место, но не трогая ячейку b36 (a36).
Ищу уже весь день, все не то. Нашел макрос который копирует несмежные ячейки, но проблема в том что вставляет их по порядку. Есть ли какие-то надстройки с уже готовыми решениями?
- Вопрос задан более трёх лет назад
- 7731 просмотр
Комментировать
Решения вопроса 1
Бизнес-аналитика, фин. моделирование, дашборды
0. Применяете фильтр по цвету.
Парная подсветка дубликатов
Среди стандартных средств Microsoft Excel есть много разных способов выделить дубликаты цветом. Самый простой и быстрый — с помощью условного форматирования. Для этого достаточно выделить диапазон ячеек и выбрать на вкладке Главная — Условное форматирование — Правила выделения ячеек — Повторяющиеся значения (Home — Conditional Formatting — Highlight Cells Rules — Duplicate Values) : 
Однако в этом случае цвет заливки у всех ячеек будет одинаковым, т.е. он просто сигнализирует о том, что у элемента где-то еще в диапазоне есть повторы, но никак не помогает их найти. Исправить ситуацию можно с помощью небольшого макроса, который будет заливать каждую пару (или больше) повторяющихся дубликатов своим цветом: 
Так гораздо нагляднее, правда? Конечно, при большом количестве повторяющихся ячеек оттенки различить будет трудно, но при относительно небольшом количестве дубликатов этот способ сработает отлично.
Чтобы использовать этот макрос нажмите сочетание клавиш Alt+F11 или кнопку Visual Basic на вкладке Разработчик (Developer), вставьте новый пустой модуль через меню Insert — Module и скопируйте туда код этого макроса:
Sub DuplicatesColoring() Dim Dupes() 'объявляем массив для хранения дубликатов ReDim Dupes(1 To Selection.Cells.Count, 1 To 2) Selection.Interior.ColorIndex = -4142 'убираем заливку если была i = 3 For Each cell In Selection If WorksheetFunction.CountIf(Selection, cell.Value) > 1 Then For k = LBound(Dupes) To UBound(Dupes) 'если ячейка уже есть в массиве дубликатов - заливаем If Dupes(k, 1) = cell Then cell.Interior.ColorIndex = Dupes(k, 2) Next k 'если ячейка содержит дубликат, но еще не в массиве - добавляем ее в массив и заливаем If cell.Interior.ColorIndex = -4142 Then cell.Interior.ColorIndex = i Dupes(i, 1) = cell.Value Dupes(i, 2) = i i = i + 1 End If End If Next cell End Sub
Теперь можно выделить любой диапазон с данными на листе и запустить наш макрос с помощью сочетания клавиш Alt+F8 или через кнопку Макросы (Macros) на вкладке Разработчик (Developer) .
Ссылки по теме
- Выделение дубликатов цветом
- Что такое макросы, куда вставлять код макроса на Visual Basic, как их запускать
- Как подсчитать количество уникальных значений в заданном диапазоне ячеек
Подсчитать сумму ячеек по цвету заливки
Задача подсчитать ячейки по цвету заливки перестала быть даже редкостью — данный вопрос постоянно появляется на форумах. Решил выложить текст пользовательской функции, которая суммирует данные ячеек на основе цвета заливки. В чем отличие от остальных функций в интернете — функция может работать только с видимыми ячейками. Т.е. если отфильтровать диапазон, то функция подсчитает данные только отфильтрованных ячеек.
Если не знаете что такое функция пользователя советую сначала прочитать статью: Что такое функция пользователя(UDF)?
Option Explicit '--------------------------------------------------------------------------------------- ' Procedure : SumByInteriorColor ' Author : The_Prist(Щербаков Дмитрий) ' http://www.excel-vba.ru ' Purpose : Функция суммирования ячеек на основе цвета заливки. ' Аргументы: ' rRange - диапазон с ячейками для суммирования. ' rColorCell - ячейка-образец с цветом заливки. ' bSumHide - ИСТИНА или 1 учитывает скрытые ячейки. ' ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не суммируются. '--------------------------------------------------------------------------------------- Function SumByInteriorColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False) 'Application.Volatile 'раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа) Dim lColor As Long, rCell As Range, dblSum As Double, vVal lColor = rColorCell.Interior.Color For Each rCell In rRange If rCell.Interior.Color = lColor Then vVal = rCell.Value If IsNumeric(vVal) Then If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then If bSumHide Then dblSum = dblSum + vVal Else dblSum = dblSum + vVal End If End If End If Next rCell SumByInteriorColor = dblSum End Function
Option Explicit ‘————————————————————————————— ‘ Procedure : SumByInteriorColor ‘ Author : The_Prist(Щербаков Дмитрий) ‘ http://www.excel-vba.ru ‘ Purpose : Функция суммирования ячеек на основе цвета заливки. ‘ Аргументы: ‘ rRange — диапазон с ячейками для суммирования. ‘ rColorCell — ячейка-образец с цветом заливки. ‘ bSumHide — ИСТИНА или 1 учитывает скрытые ячейки. ‘ ЛОЖЬ, 0 или опущен(по умолчанию) — скрытые ячейки не суммируются. ‘————————————————————————————— Function SumByInteriorColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False) ‘Application.Volatile ‘раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа) Dim lColor As Long, rCell As Range, dblSum As Double, vVal lColor = rColorCell.Interior.Color For Each rCell In rRange If rCell.Interior.Color = lColor Then vVal = rCell.Value If IsNumeric(vVal) Then If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then If bSumHide Then dblSum = dblSum + vVal Else dblSum = dblSum + vVal End If End If End If Next rCell SumByInteriorColor = dblSum End Function
Чтобы правильно использовать приведенный код, необходимо сначала ознакомиться со статьей Что такое функция пользователя(UDF)?. Вкратце: скопировать текст кода выше, перейти в редактор VBA( Alt + F11 ) -создать стандартный модуль(Insert —Module) и в него вставить скопированный текст. После чего функцию можно будет вызвать из Диспетчера функций( Shift + F3 ), отыскав её в категории Определенные пользователем (User Defined Functions) .
Синтаксис функции:
без учета скрытых строк и столбцов:
=SumByInteriorColor( $A$1:$A$10 ; B1 )
все ячейки(с учетом скрытых):
=SumByInteriorColor( $A$1:$A$10 ; B1 ;1)
rRange( $A$1:$A$10 ) — ссылка на диапазон с ячейками для суммирования.
rColorCell( B1 ) — ссылка на ячейка-образец с цветом заливки.
bSumHide — Если указано ИСТИНА (TRUE) или 1 учитывает скрытые ячейки. ЛОЖЬ (FALSE) , 0 или опущен(по умолчанию) — скрытые ячейки не суммируются.
Чтобы подсчитывалось количество ячеек, а не их сумма, то следует применить другую функцию:
'--------------------------------------------------------------------------------------- ' Procedure : CountByInteriorColor ' Author : The_Prist(Щербаков Дмитрий) ' http://www.excel-vba.ru ' Purpose : Функция подсчета ячеек на основе цвета заливки. ' Аргументы: ' rRange - диапазон с ячейками для подсчета. ' rColorCell - ячейка-образец с цветом заливки. ' bSumHide - ИСТИНА или 1 учитывает скрытые ячейки. ' ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не подсчитываются. ' IsMissEmpty - если ИСТИНА или 1(по умолчанию) - пустые ячейки пропускаются ' ЛОЖЬ, 0 или опущен - пустые ячейки не суммируются '--------------------------------------------------------------------------------------- Function CountByInteriorColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False, _ Optional IsMissEmpty As Boolean = True) 'Application.Volatile 'раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа) Dim lColor As Long, rCell As Range, lCnt As Long, vVal lColor = rColorCell.Interior.Color For Each rCell In rRange If rCell.Interior.Color = lColor Then vVal = 1 If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then If Not bSumHide Then vVal = 0 End If End If If IsMissEmpty Then If Len(rCell.Value) = 0 Then vVal = 0 End If End If lCnt = lCnt + vVal End If Next rCell CountByInteriorColor = lCnt End Function
‘————————————————————————————— ‘ Procedure : CountByInteriorColor ‘ Author : The_Prist(Щербаков Дмитрий) ‘ http://www.excel-vba.ru ‘ Purpose : Функция подсчета ячеек на основе цвета заливки. ‘ Аргументы: ‘ rRange — диапазон с ячейками для подсчета. ‘ rColorCell — ячейка-образец с цветом заливки. ‘ bSumHide — ИСТИНА или 1 учитывает скрытые ячейки. ‘ ЛОЖЬ, 0 или опущен(по умолчанию) — скрытые ячейки не подсчитываются. ‘ IsMissEmpty — если ИСТИНА или 1(по умолчанию) — пустые ячейки пропускаются ‘ ЛОЖЬ, 0 или опущен — пустые ячейки не суммируются ‘————————————————————————————— Function CountByInteriorColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False, _ Optional IsMissEmpty As Boolean = True) ‘Application.Volatile ‘раскомментировать, чтобы функция обновляла свои значения по нажатию Shift+F9(пересчет листа) Dim lColor As Long, rCell As Range, lCnt As Long, vVal lColor = rColorCell.Interior.Color For Each rCell In rRange If rCell.Interior.Color = lColor Then vVal = 1 If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then If Not bSumHide Then vVal = 0 End If End If If IsMissEmpty Then If Len(rCell.Value) = 0 Then vVal = 0 End If End If lCnt = lCnt + vVal End If Next rCell CountByInteriorColor = lCnt End Function
Синтаксис и аргументы практически полностью идентичны с функцией SumByInteriorColor, за исключением последнего — IsMissEmpty . Т.к. функция подсчета только считает кол-во окрашенных цветом ячеек, то бывает необходимо подсчитывать только те ячейки, в которых что-то записано(т.е. есть какое-то значение). Аргумент IsMissEmpty как раз за это и отвечает — если установить его в ИСТИНА (TRUE) или 1(или вообще не указывать), то будут подсчитаны только те закрашенные ячейки, в которых что-то есть. Если указать ЛОЖЬ (FALSE) или 0 — то подсчитаны будут абсолютно все окрашенные в указанный цвет ячейки.
Синтаксис функции:
без учета скрытых строк и столбцов, только со значениями:
=CountByInteriorColor( $A$1:$A$10 ; B1 )
с учетом скрытых строк и столбцов, только со значениями:
=CountByInteriorColor( $A$1:$A$10 ; B1 ;1)
все ячейки(и скрытые и без значений):
=CountByInteriorColor( $A$1:$A$10 ; B1 ;1;0)
rRange( $A$1:$A$10 ) — ссылка на диапазон с ячейками для подсчета.
rColorCell( B1 ) — ссылка на ячейка-образец с цветом заливки.
bSumHide — Если указано ИСТИНА (TRUE) или 1 учитывает скрытые ячейки. ЛОЖЬ (FALSE) , 0 или опущен(по умолчанию) — скрытые ячейки не подсчитываются.
IsMissEmpty — если ИСТИНА (TRUE) , 1 или опущен(по умолчанию), то будут подсчитаны только те закрашенные ячейки, в которых что-то есть. Если указать ЛОЖЬ (FALSE) или 0 — то подсчитаны будут абсолютно все окрашенные в указанный цвет ячейки.
Что следует учитывать: функции подсчитывают и суммируют ячейки на основании цвета заливки, установленного вручную с панели. Если заливка ячеек создана при помощи условного форматирования, то функции не определят цвет этой ячейки. Это связано с особенностями создания визуального изменения свойств ячейки при помощи условного форматирования.
Так же функции не будут автоматически обновлять значения сразу после смены заливки ячеек — это особенность Excel. Поэтому при изменении заливки в вычисляемом диапазоне необходимо вручную пересчитать функцию( F2 — Enter ).
Статья помогла? Поделись ссылкой с друзьями!