Sub run_Interior_ColorIndex()

Dim oSh As Worksheet

Set oSh = ThisWorkbook.Sheets("Data")

With oSh

Lng_RowsEnd = .Cells(65256, 1).End(xlUp).Row

Range(.Cells(2, 1), .Cells(Lng_RowsEnd, 24)).Interior.Color = xlNone

End With

Call Interior_ColorIndex_Type(oSh:=oSh, strVal:="qqqq", Lng_ColorIndex:=15, Lng_ClnCheck:=15, Lng_ClnStart:=1, Int_ClnEnd:=24)

End Sub

Sub Interior_ColorIndex_Type( _

ByVal oSh As Worksheet, _

ByVal strVal As String, _

ByVal Lng_ColorIndex As Long, _

ByVal Lng_ClnCheck As Long, _

ByVal Lng_ClnStart As Long, _

ByVal Int_ClnEnd As Long)

iCountMod = 5000

Dim rRange As Range

With oSh

Lng_RowsEnd = .Cells(65256, 1).End(xlUp).Row

ar = Range(.Cells(2, Lng_ClnCheck), .Cells(Lng_RowsEnd, Lng_ClnCheck)).Value

For i = LBound(ar) To UBound(ar) ' цикл по строкам диапазона

If Trim(ar(i, 1)) = strVal Then ' если ячейка диапазона...

If rRange Is Nothing Then ' диапазон еще пустой

Set rRange = Range(.Cells(i + 1, Lng_ClnStart), .Cells(i + 1, Int_ClnEnd)) ' формируем диапазон

Else

Set rRange = Union(rRange, Range(.Cells(i + 1, Lng_ClnStart), .Cells(i + 1, Int_ClnEnd))) ' пополняем диапазон

End If

End If

If (i Mod iCountMod) = 0 Then

rRange.Interior.ColorIndex = Lng_ColorIndex

DoEvents

'Stop

Set rRange = Nothing

End If

Next i

End With

rRange.Interior.ColorIndex = Lng_ColorIndex

End Sub

.Interior.Color = vbRed

.Interior.Color = RGB(255, 0, 0)

.Interior.Color = 255

'Работа с объектами листа медленная. Если ячеек много и заливать нужно не целым диапазоном, можно обработать в памяти и залить ячейки одной командой.

Sub PaintCells()

Dim r1 As Range, r2 As Range

Dim c As Range

Set r1 = Range("A1:C10") ' диапазон в переменную

r1.Interior.Pattern = xlNone ' убираем заливку

' r1.Interior.ColorIndex = 0 ' или так

For Each c In r1 ' цикл по ячейкам диапазона

If c.Value = 25 Then ' если условие выполняется

If r2 Is Nothing Then ' диапазон еще пустой

Set r2 = c ' формируем диапазон

Else

Set r2 = Union(r2, c) ' пополняем диапазон

End If

End If

Next c

If Not r2 Is Nothing Then r2.Interior.Color = 255 ' заливаем

Set r1 = Nothing: Set r2 = Nothing ' освобождаем память

End Sub

'Залить строки по условию в ячейке:

For i = 1 To r1.Rows.Count ' цикл по строкам диапазона

If r1(i, 1).Value = 25 Then ' если левая ячейка диапазона...

If r2 Is Nothing Then ' диапазон еще пустой

Set r2 = Range(Cells(i, 1), Cells(i, 3)) ' формируем диапазон

Else

Set r2 = Union(r2, Range(Cells(i, 1), Cells(i, 3))) ' пополняем диапазон

End If

End If

Next i