Как найти ячейку по цвету vba

 

Никита Соловьев

Пользователь

Сообщений: 39
Регистрация: 09.09.2021

#1

14.09.2021 10:24:02

Добрый день. Пытаюсь написать макрос, который будет искать только желтые ячейки и снимать заливку. В таблицу есть ячейки залитые другими цветами, нужно чтобы отлавливал только желтые. Из того, что написал сам, не работает.

Код
Sub отлов
With ThisWorkbook.ActiveSheet

    For i = 5 To 30
        ActiveSheet.Rows(i).Select
        If ActiveCell.EntireRow.Interior.ColorIndex = Yellow Then ActiveCell.EntireRow.Interior.Pattern = xlNone
    Next
End With
End Sub

Изменено: Никита Соловьев14.09.2021 11:00:25

На работе столкнулся с такой задачей — имеется таблица в Excel, в которой ведется табель выходов рабочих в цеху.

В таблице подсчитывается количество часов, фактически отработанных; часов переработки и часов сверх нормы. Так вот, необходимо сделать так, чтобы производилась автоматическая выборка ячеек таблицы по цвету заливки последних.

То есть, нужно отобрать все ячейки с заливкой определенного цвета, подсчитать их количество; а затем применить к полученному значению определенные формулы.

Чтобы было понятнее, приведу изображение подобной таблицы. В ней необходимо произвести подсчет ячеек с заливкой зеленого цвета:

Табель выходов с зелеными ячейками

В Excel нет встроенных (готовых) инструментов для выборки подобного рода; можно отбирать ячейки только по одному условию — по значению, находящемуся в них. Поэтому решение задачи получалось только одно — через VBA (пользовательские функции).

Прекрасное и готовое решение моей задачи я нашел на сайте http://www.excel-vba.ru/. Даже не одно, а целых два решения, под разные условия. Ниже привожу последовательность шагов, которые привели меня к успеху.

Сразу скажу, что изображения были сделаны в Excel 2007. В Excel 2010 все несколько по другому, но запутаться невозможно, если что.

Первое, что нужно сделать — заставить Excel работать с пользовательскими функциями. Фактически, мы будем писать сценарий на языке VBA в Excel, но такая возможность по умолчанию отключена в этой программе. Включить ее можно следующим образом.

Переходим в “Пуск — Параметры Excel” и находим в левом списке пункт “Надстройки”:

Excel - надстройка VBA

Выбираем в основном окне строчку “Пакет анализа — VBA” и жмем кнопочку “Перейти” в самом низу окна. Откроется еще одно окошко со списком доступных под Excel расширений (надстроек). Снова выбираем в этом списке “Пакет анализа — VBA” и соглашаемся, что хотим установить его, нажав кнопку “ОК”:

Excel - Пакет анализа VBA

Потребуется установочный диск с Microsoft Office на нем (или же подключение к Интернет) чтобы программа получила необходимые пакеты для инсталляции. Если установка прошла успешно, то в “Ленте” появиться пункт “Разработчик” (Excel 2010). Можно перейти в него через эту панель или же с помощью сочетания клавиш Alt + F11.

Появиться окно, в котором выполняется написание кода на языке VBA, то есть фактически создаются пользовательские функции. Я писать их не буду, так как языка VBA не знаю и знать особого желания нет (все знать невозможно).

Вставка готовых функций в Excel VBA

Но есть готовые решения, которые я вставлю в виде кода с помощью меню “Insert — Module”. Просто берем отсюда код функций и вставляем в свой Excel. Затем сохраняем файл Excel с поддержкой VBA (макросов) и все готово для дальнейшей работы.

Вставленные функции появятся в списке формул таблицы:

Excel - пользовательские функции

Ниже представлен готовый код двух функций на VBA, написанных их автором Дмитрием Щербаковым. Первая функция с именем “CountByInteriorColor” выполняет подсчет количества ячеек по цвету заливки.

Вторая функция с именем “SumByInteriorColor” выполняет выборку ячеек по цвету заливки и суммирует все значения в этих ячейках.

Обе функции имеют одинаковый синтаксис и принимают три входных аргумента, первые два из которых обязательные, а третий — необязательный:


  • 1
    
    rRange
    

    — диапазон с ячейками для подсчета


  • 1
    
    rColorCell
    

    — ячейка-образец с цветом заливки


  • 1
    
    bSumHide
    

    1
    
    ИСТИНА
    

    или

    1
    
    1
    

    учитывает скрытые ячейки;

    1
    
    ЛОЖЬ
    

    ,

    1
    
    0
    

    или опущен(по умолчанию) — скрытые ячейки не подсчитываются.

Функция подсчета количества ячеек

'---------------------------------------------------------------------------------------
' Procedure : CountByInteriorColor
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция подсчета ячеек на основе цвета заливки.
' Аргументы:
'             rRange     - диапазон с ячейками для подсчета.
'             rColorCell - ячейка-образец с цветом заливки.
'             bSumHide   - ИСТИНА или 1 учитывает скрытые ячейки.
'                          ЛОЖЬ, 0 или опущен(по умолчанию) - скрытые ячейки не подсчитываются.
'---------------------------------------------------------------------------------------
Function CountByInteriorColor(rRange As Range, rColorCell As Range, Optional bSumHide As Boolean = False)
  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
          If rCell.EntireRow.Hidden Or rCell.EntireColumn.Hidden Then
              If bSumHide Then lCnt = lCnt + 1
          Else
              lCnt = lCnt + 1
          End If
      End If
  Next rCell
  CountByInteriorColor = lCnt
End Function

Синтаксис этой функции прост:

=CountByInteriorColor(D8:AG8;$E$65)

Функция подсчета суммы ячеек

'---------------------------------------------------------------------------------------
' 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)
  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

Синтаксис этой функции следующий:

=SumByInteriorColor(D8:AG37;E63)

При вставке пользовательской функции “CountByInteriorColor” и “SumByInteriorColor” можно воспользоваться либо “Мастером функций”, либо произвести указание диапазона ячеек и ячейку-критерий вручную.

Описание рабочей формулы

Готовый пример работы функции “CountByInteriorColor” можно посмотреть на рисунке “Табель выходов с зелеными ячейками”. В нем подсчет отработанного времени производится по следующей формуле:

=((Сумма фактически отработанных часов) - (Норма часов выхода за месяц)) + ((Кол-во дней с переработкой)*4)

Фактически эта формула получается такой (смотри строку №13 на рисунке):

=(AH13-AI13) + (CountByInteriorColor(D13:AG13;$E$65)*4)

Думаю, что больше сказать по поводу создания (точнее — вставки готового решения) пользовательских функций и способа выборки ячеек в таблице по цвету их заливки мне нечего.


cybereug

Гость


необходимо в excel найти в столбце 1 ячейку синего цвета и скопировать ее в столбец 2 во все строки до нахождения следующей синей ячейки в столбце 1. Далее опять копируется синяя ячейка до нахожденя следующей синей. Заранее спасибо!


Записан
HandKot

Молодой специалист

ru
Offline Offline


Сервис-Макрос-Начать запись

Потом выбираешь Правка-Найти Формат, указываешь цвет ячейки для поиска

После посмотри полученный код и подгони его под себя


Записан

I Have Nine Lives You Have One Only
THINK!

PooH

Глобальный модератор

ru
Offline Offline
Пол: Мужской

… и можно без хлеба!


а зачем тут синию искать?  иди по столбцу и как наткнулся на синию, начинай её вставлять во второй столбец для всех «не синих»


Записан

Удачного всем кодинга! -=x[PooH]x=-

cybereug

Гость


а как это програмно сделать? вопрос в том что синие ячейки имеют разные значения и значение должно меняться после нахождения следующей синей ячейки

« Последнее редактирование: 18-07-2006 14:05 от cybereug »
Записан
cybereug

Гость


вот в приложении примерно что нужно сделать и что должно получиться

RomCom


Sub Макрос1()
Dim sht As Worksheet, i As Integer
Set sht = Application.ActiveWorkbook.ActiveSheet

‘находим первую синию ячейку
For i = 1 To 100 ‘100 — диапазон
    If sht.Cells(i, 1).Interior.ColorIndex = 5 Then
        Exit For
    End If
Next

‘ну и собственно вставка
For i = i To 100 ‘100 — диапазон
    If sht.Cells(i, 1).Interior.ColorIndex = 5 Then
        sht.Cells(i, 1).Select
        Selection.Copy
    Else
            sht.Cells(i, 2).Select
            sht.Paste
    End If
Next
End Sub

« Последнее редактирование: 19-12-2007 18:19 от Алексей1153++ »
Записан

R.O.M.C.O.M.: Robotic Operational Mathematics and Ceaseless Observation Machine

cybereug

Гость


большое спасибо! а как удалить потом строчки с синими ячейками с кторых начиналась вставка?

« Последнее редактирование: 19-07-2006 04:44 от cybereug »
Записан

I am trying to serach for a cells by color and select them one by one to copy their values.

I have this so far. But I am just crashing excel with this

Sub searchcol()

Range("O3:O2555").Select
With Application.FindFormat.Interior
    .PatternColorIndex = 6
 End With
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=True).Select

‘ do copy operation for each cell in this range
End Sub

asked Dec 11, 2014 at 9:55

dagan's user avatar

This will go to each cell and check the colour, if it is equal to 65535 (Yellow) it will print the value in the immediate window. You could amend the code to put the values elsewhere. Hope this helps.

Range("O3").Select
Do While ActiveCell.Value <> ""
    If ActiveCell.Interior.Color = 65535 Then
        Debug.Print ActiveCell.Value
    End If
    ActiveCell.Offset(1, 0).Select
Loop

answered Dec 11, 2014 at 10:08

Paul's user avatar

PaulPaul

112 bronze badges

1

0 / 0 / 0

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

Сообщений: 6

1

Нужно найти ячейки на листе залитые неким цветом, удалить их содержимое, и изменить заливку на прозрачную.

28.11.2010, 00:16. Показов 5350. Ответов 5


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

Господа. Помогите пожалуйста чайнику. Возможно тема и не нова, но очень надо. Ситуация такова: нужно найти ячейки на листе залитые неким (любым,кроме прозрачного)цветом, удалить их содержимое, и изменить заливку на прозрачную. Как сделать поиск по значению я знаю, а вот как найти залитую нет. Заранее спасибо.



0



Gacol

1 / 1 / 0

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

Сообщений: 112

28.11.2010, 07:01

2

Можно так

Visual Basic
1
2
3
4
5
6
For Each c In [MyRange]
   If c.Interior.ColorIndex <> xlNone Then
      с.value = empty
      c.Interior.ColorIndex = xlNone
   End If
Next c

Только укажи ограниченный [MyRange]. Если задать весь лист — поседеешь ждать.
Границы области со значащами ячейками можно определить так

Visual Basic
1
2
myMaxRow  = UserRange.Row
myMaxCol  = UserRange.Column



0



0 / 0 / 0

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

Сообщений: 6

28.11.2010, 22:53

3

Огромное спасибо. Все работает.



0



pashulka

4131 / 2235 / 940

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

Сообщений: 4,624

01.12.2010, 02:52

4

Вопрос для Gacol
Что выдаст подобный код если таблица начинается не с первой строки и не с первого столбца ???

Visual Basic
1
2
myMaxRow = UserRange.Row
myMaxCol = UserRange.Column

Естественно ошибку 424, т.к. свойство именуется UsedRange

Visual Basic
1
2
3
4
5
6
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex <> xlNone Then
с = ''
c.Interior.ColorIndex = xlNone
End If
Next



0



1 / 1 / 0

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

Сообщений: 112

01.12.2010, 07:51

5

Ну пардон, виноват, опИсался.



0



4131 / 2235 / 940

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

Сообщений: 4,624

01.12.2010, 12:37

6

Люблю людей с чувством юмора.

Однако самый главное, что в таблице, которая начинается к примеру с десятой строки и содержит всего пять строк
подобная инструкция :
iRow = ActiveSheet.UsedRange.Row
выдаст естественно пять (5)

А вот пример более точного определения последней строки в таблице :
iRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count — 1
P.S. Столбец определяется аналогично.



0



Понравилась статья? Поделить с друзьями:
  • Как найти параллельные стороны прямоугольника
  • Как исправить прошлое своей
  • История что это за ошибка как исправить
  • Истории как я нашел котенка
  • Как найти трансляции за весь