помогите доработать макросы (скрыть/отоброзить строки)

[Anyuta]

Помогите пожалуйста доработать макросы!

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

Нужно что бы в "Диапазоне_данных" проверялся цвет каждой ячейки в строке
Если там есть хотя бы одна ячейка заданного цвета (голубого) то эта строка отображалась
иначе - скрывалась
Т.е. отображались только строки удовлетворяющие условию, все остальные скрывались,
и соответсвенно если до этого уже применялся другой макрос на сокрытие строк, надо что бы перед тем как макрос начал проверять строки, он сначала все строки отобразил, что бы не получилось что ранее скрытая строка (возможно удовлетворяет условию, но так она уже была скрыта то она и не отоброзится)

вот недоваренный макрос:

Код Выделить Развернуть

Sub Отоброзить_ячейки_голубого_цвета()
    Dim cell As Range
    Application.ScreenUpdating = False                                      'отключаем обновление экрана для ускорения
    For Each cell In ActiveSheet.Range("Диапазон_данных").Cells                     'проходим по всем ячейкам первого столбца
        If cell.Interior.ColorIndex = 8 Then cell.EntireRow.Hidden = False   'если ячейка в диапазоне заданного цвета - отоброжаем строку
    Next
    Application.ScreenUpdating = True
End Sub

И нужен еще один почти такой же на условие что если в "диапазоне_данных" в строке есть хоть одна ячейка голубого цвета и хоть одна ячейка красного цвета она отображалась, все остальные скрывались.

[RAN]

Чтой-то мне кажется, что эта "хоть одна ячейка голубого цвета " красится УФ.

[kuklp]

Мне кажется, что я ослеп:

В приложении файл

[Anyuta]

извиняюсь, файл добавила

нет не УФ, заливка делается вручную

[RAN]

Код Выделить Развернуть

Sub Мяу()
Application.ScreenUpdating = False
    [A5].CurrentRegion.Rows.Hidden = False
    For Each rw In [A5].CurrentRegion.Rows
        For Each cl In rw.Cells
            Select Case cl.Interior.Color
            Case 16776997, 2960895
                cl.EntireRow.Hidden = True
                Exit For
            End Select
        Next
    Next
End Sub


[Anyuta]

RAN, макрос скрывает нужные ячейки, надо что бы отображал только их и скрывал все остальное
и надо именно чтобы макрос работал только в "диапазоне_данных", т.е. ниже и выше пойдут другие данные с которыми макрос не должен никак работать

на скрытие нужных ячеек я собрала с горем пополам макрос

Код Выделить Развернуть

Sub Скрыть_ячейки_голубого_цвета()
    Dim cell As Range
    Application.ScreenUpdating = False
    For Each cell In ActiveSheet.Range("Диапазон_данных").Cells
        If cell.Interior.ColorIndex = 8 Then cell.EntireRow.Hidden = True
    Next
    Application.ScreenUpdating = True
End Sub

мне нужно отредактировать тут
1) как прописать что бы сперва "диапазон данных" полностью отобразился? (что бы ни пропали скрытые ранее строки)
2)  изменить

Код Выделить Развернуть

If cell.Interior.ColorIndex = 8 Then cell.EntireRow.Hidden = False
else ... (иначе скрыть строку)

по возможности, видоизменяйте выложенный макрос, потому что я профан в VB, что бы мне аналогично собрать макрос с некоторыми другими условиями не пришлось изучать весь VB

Anyuta, оформляйте код тегами! [Модератор]

[RAN]

Код Выделить Развернуть

Sub Мяу()
    Application.ScreenUpdating = False
    [A6].CurrentRegion.Rows.Hidden = False
    For Each rw In [A6].CurrentRegion.Rows
        For Each cl In rw.Cells
            Select Case cl.Interior.Color
            Case 16776997, 2960895
                flag = True
                Exit For
            End Select
        Next
        If flag = False Then rw.EntireRow.Hidden = True
        flag = False
    Next
End Sub

[Anyuta]

RAN спасибо, но это не совсем то что нужно, он работает у меня по всему документу, т.е. скрывает мне и шапку и хвост, мне надо что бы только в определенном диапазоне С8:AD1204 т.к. будут добавляться новые строки, я так понимаю что нужно задать имя диапазону, или я что то неверно понимаю?

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

[RAN]

Код Выделить Развернуть

Sub Мяу()
    Application.ScreenUpdating = False
    '    With Range("Диапазон_данных")    ' можно и так
    With [A6].CurrentRegion.Offset(2).Resize([A6].CurrentRegion.Rows.Count - 3)
        .Rows.Hidden = False
        For Each rw In .Rows
            For Each cl In rw.Cells
                Select Case cl.Interior.Color
                Case 16776997
                    flag1 = 1
                Case 2960895
                    flag2 = 1
                End Select
            Next
            If flag1 + flag2 < 2 Then rw.EntireRow.Hidden = True
            flag1 = 0: flag2 = 0
        Next
    End With
End Sub

[Anyuta]

RAN спасибо наиогроменнейшее! все работает 
Два вопроса еще
1) в какой системе у вас кодировка цвета? я че то никак не сооброжу как мне остальные цвета прописать, мне просто такой же макрос нужен будет на желтый, зеленый, коричневый и без заливки
2) макрос на один цвет для нужного мне диапазона выглядит так?

Код Выделить Развернуть

Sub Мяу()
    Application.ScreenUpdating = False
    With Range("Диапазон_данных")    ' можно и так
         .Rows.Hidden = False
       For Each rw In .Rows
        For Each cl In rw.Cells
            Select Case cl.Interior.Color
            Case 2960895
                flag = True
                Exit For
            End Select
        Next
        If flag = False Then rw.EntireRow.Hidden = True
        flag = False
    Next
  End With
End Sub

[RAN]

1. Понятия не имею
Закрасьте ячейки и выполните макрос

Код Выделить Развернуть

ActiveCell.Value = Val(ActiveCell.Interior.Color)
Без заливки

Код Выделить Развернуть

cl.Interior.Pattern = xlNone
2. Так.

[Anyuta]

Спасибо, разобралась с цветами, все отлично работает!