Найти данные и залить цветом

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Найти данные и залить цветом (Макросы/Sub)

Stormy

Дата: Среда, 24.11.2021, 14:33 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 366

Репутация: 12 ±

Замечаний: 0% ±

Excel 2010

Всем привет.
Подсобите, пожалуйста, с макросом
Есть таблица с двумя столбцами, нужно сравнить 2 столбца и залить цветом.
К примеру в столбце В ищем 22,81 , найдя закрашиваем в зеленый цвет ячейку в столбце В и соседнюю в столбце С.
То же самое проделываем со столбцом D , если 22.81 есть в этом столбце, закрашиваем эту ячейку и соседнюю в столбце С.

К сообщению приложен файл: 3072304.xlsx (13.9 Kb)

Место для рекламы.

Ответить

jun

Дата: Среда, 24.11.2021, 14:56 | Сообщение № 2

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 145

Репутация: 43 ±

Замечаний: 0% ±

Посмотрите:

[vba]

Код

Sub Сравнение()
    Dim i As Range, k As Range
    Dim LastRow As Long
    With ThisWorkbook.Worksheets("Лист1")
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        For Each i In .Range("B4:B" & LastRow)
            For Each k In .Range("D4:D" & LastRow)
                If i.Value = "22,81" And i = k Then
                    i.Interior.Color = vbGreen
                    i.Offset(0, 1).Interior.Color = vbGreen
                    k.Interior.Color = vbGreen
                End If
            Next k
        Next i
    End With
End Sub

[/vba]

К сообщению приложен файл: 8780717.xlsb (16.8 Kb)

Сообщение отредактировал jun - Среда, 24.11.2021, 14:56

Ответить

Stormy

Дата: Среда, 24.11.2021, 15:34 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 366

Репутация: 12 ±

Замечаний: 0% ±

Excel 2010

jun,
Все верно, но нужно и остальные значения точно так же как и 22,81 найти и залить

Место для рекламы.

Ответить

jun

Дата: Среда, 24.11.2021, 16:52 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 145

Репутация: 43 ±

Замечаний: 0% ±

Код:
[vba]

Код

Sub Сравнение()
    Dim i As Range, k As Range
    Dim LastRow As Long
    With ThisWorkbook.Worksheets("Лист1")
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        For Each i In .Range("B4:B" & LastRow)
            For Each k In .Range("D4:D" & LastRow)
                If i = k Then
                    i.Interior.Color = vbGreen
                    i.Offset(0, 1).Interior.Color = vbGreen
                    k.Interior.Color = vbGreen
                End If
            Next k
        Next i
    End With
End Sub

[/vba]
Заменил
[vba]

Код

If i.Value = "22,81" And i = k Then

[/vba]
на
[vba]

Код

If i = k Then

[/vba]
Заливает все зеленым цветом