Sub СкрытьБелыхИ_х()

Dim с As Date
Dim d As Single
'Больше не обновляем страницы после каждого действия
  Application.ScreenUpdating = False
'Отключаем события
  Application.EnableEvents = False
'Расчёты переводим в ручной режим
  Application.Calculation = xlCalculationManual
  c = Time
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub
     
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireRow.Hidden = False
    Dim tb As ListObject
    For Each tb In ActiveSheet.ListObjects
        JobTb tb
    Next
    Application.ScreenUpdating = True
    d = (Time - c) * 24 * 60 * 60
'Расчёты переводим в автоматический режим
  Application.Calculation = xlCalculationAutomatic
'Включаем события
  Application.EnableEvents = True
'Включаем обновление страниц после каждого действия
  Application.ScreenUpdating = True

    MsgBox "Время выполения макроса составило: " & d & " c.", vbInformation, "Отчет"
End Sub
Private Sub JobTb(tb As ListObject)
    Dim flag As Boolean
    Dim cl As Range
    For Each cl In tb.DataBodyRange.Columns(1).Cells
        flag = False
        If cl.Cells(1, 14).Value = "х" Then
            flag = True
        End If
        Select Case cl.Interior.Color
        Case 11389944, 14277081
        Case Else
            flag = True
        End Select
         
        If flag Then cl.EntireRow.Hidden = True
    Next
End Sub

Sub HideColumnsRows()
   With Worksheets("Литс 1")
      .Columns(14).Hidden = True
      .Rows("5:9").Hidden = True
   End With
End Sub

Private Sub JobTurbo(tb As ListObject)
    Dim wks As Worksheet, rng As Range, colA As Range, column As Range
    Dim val As Variant, t As Variant, i As Long
    
    t = Timer
    Set colA = tb.DataBodyRange.Columns(1) 'колонка цвета
    Set column = tb.DataBodyRange.Columns(14) 'колонка крестиков
    
    Set wks = tb.Parent
    Set rng = wks.UsedRange.Columns(wks.UsedRange.Columns.Count).Offset(0, 2)
    Set rng = Intersect(rng, column.EntireRow) 'временная колонка отметок (единичек)
    val = rng.Value
    For i = 1 To column.Cells.Count
        'отмечаем скрываемые строки единичками
        If column.Cells(i) = "х" Then val(i, 1) = 1 'здесь по крестику
        Select Case colA.Cells(i).Interior.Color
            Case 11389944, 14277081
            Case Else
                val(i, 1) = 1 'и здесь по цвету
        End Select
    Next i
    rng.Value = val
    
    On Error Resume Next
    rng.SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = True '1 = Числа
    On Error GoTo 0
    rng.EntireColumn.Delete 'удаление временной колонки отметок (единичек)
    
    Debug.Print Timer - t
End Sub

    For Each tb In ActiveSheet.ListObjects
        'JobTb tb
        JobTurbo tb
    Next

Private Sub JobTurbo2(tb As ListObject)
    Dim wks As Worksheet, rng As Range, colA As Range, column As Range
    Dim val As Variant, t As Variant, valCol As Variant, i As Long, iMax As Long
    
    t = Timer
    Set colA = tb.DataBodyRange.Columns(1) 'колонка цвета
    Set column = tb.DataBodyRange.Columns(14) 'колонка крестиков
    
    Set wks = tb.Parent
    Set rng = wks.UsedRange.Columns(wks.UsedRange.Columns.Count).Offset(0, 2)
    Set rng = Intersect(rng, column.EntireRow) 'временная колонка отметок (единичек)
    val = rng.Value
    valCol = column.Value
    iMax = column.Cells.Count
    For i = 1 To iMax
        'отмечаем скрываемые строки единичками
        If valCol(i, 1) = "х" Then
            val(i, 1) = 1 'здесь по крестику
        Else
            Select Case colA.Cells(i).Interior.Color
                Case 11389944, 14277081
                Case Else
                    val(i, 1) = 1 'и здесь по цвету
            End Select
        End If
    Next i
    rng.Value = val
    
    On Error Resume Next
    rng.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Hidden = True
    On Error GoTo 0
    rng.EntireColumn.Delete 'удаление временной колонки отметок (единичек)
    
    Debug.Print Timer - t
End Sub

Private Sub JobTurbo3(tb As ListObject)
    Dim wks As Worksheet, rng As Range, colA As Range, column As Range
    Dim val As Variant, t As Variant, valCol As Variant, i As Long, iMax As Long
    
    t = Timer
    Set colA = tb.DataBodyRange.Columns(1) 'колонка цвета
    Set column = tb.DataBodyRange.Columns(14) 'колонка крестиков
    
    Set wks = tb.Parent
    Set rng = wks.UsedRange.Columns(wks.UsedRange.Columns.Count).Offset(0, 2)
    Set rng = Intersect(rng, column.EntireRow) 'временная колонка отметок (единичек)
    val = rng.Value
    valCol = column.Value
    iMax = column.Cells.Count
    For i = 1 To iMax
        'отмечаем скрываемые строки единичками
        If valCol(i, 1) = "х" Then
            val(i, 1) = 1 'здесь по крестику
        Else
            Select Case colA.Cells(i).Interior.Color
                Case 11389944, 14277081
                Case Else
                    val(i, 1) = 1 'и здесь по цвету
            End Select
        End If
    Next i
    rng.Value = val
    
    rng.EntireRow.Hidden = True 'сначала скрываем просто ВСЁ сразу
    On Error Resume Next 'и потом некоторые (меньшую часть) показываем
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
    On Error GoTo 0
    rng.EntireColumn.Delete 'удаление временной колонки отметок (единичек)
    
    Debug.Print Timer - t
End Sub