>>237
自分で15万行のデータで試したらDebug.Print i を外しても遅すぎたので作り直し
うちでは5秒でした　（Core2Duo E7500 RAM8G win10 Excel2010) 元データのF列に色がないことが条件ですけどね

Sub TEST1()
Dim startTime As Double: startTime = Timer
Application.ScreenUpdating = False
Dim A
A = ActiveSheet.Range("A1").CurrentRegion
For i = UBound(A, 1) To 2 Step -1
If A(i, 6) = "Distribution (PCW; Sales value)" Then
If A(i, 7) <= 3 Then
Cells(i, 6).Resize(3, 1).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
'
Application.ScreenUpdating = True
Dim mySheet As Worksheet: Set mySheet = ActiveSheet
Dim tempSheet As Worksheet: Set tempSheet = Worksheets.Add
Dim myRange As Range: Set myRange = mySheet.Range("A1").CurrentRegion
myRange.AutoFilter Field:=6, Operator:=xlFilterNoFill
myRange.Offset(1, 0).Resize(myRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy tempSheet.Range("A1")
mySheet.ShowAllData
myRange.Clear
tempSheet.Range("A1").CurrentRegion.Copy mySheet.Range("A1")
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
MsgBox (Timer - startTime & "秒でした")
End Sub