Скрытие определенных строк при установке флажка

[DMaksimov]

Здравствуйте!

Делаю таблицу для расчета дисбурсментских счетов. Понадобилось сделать макрос, который бы при установленном флажке скрывал строки с определенным расчитываемым значением во второй ячейке. В моем случае формула ставит текст "СКРЫТЬ". Буду благодарен за помощь. Образец на скрепке.

P.S. Видел несколько похожих тем, но так и не смог приспособить примеры под свои нужды

[Poltava]

Возможно так подойдет

[Alex_ST]

Poltava,
маленькая поправка: теряете последнюю строку и забываете включить ScreenUpdating (выделил красным)
И чуть подсократил:
Sub Флажок2_Щелчок()
   Application.ScreenUpdating = False
   Dim tCell As Range
   For Each tCell In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1))
       tCell.Rows.Hidden = tCell.Value = "СКРЫТЬ" And Cells(1, 3).Value
   Next tCell
   Application.ScreenUpdating = True
End Sub

[Poltava]

Спасибо за внимательность +1 Вам! писал вечером уставший принимаю все замечания но не все исправления! даже используя ваш код мы будем продолжать терять строки если скрытыми окажется больше 1 строки в конце! все дело в том что я забыл о особенностях

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

.End(xlUp).Row
такого  метода определения последней строки, а именно о том что он пропускает скрытые строки и +1 здесь не спасает
предлагаю такой вариант.

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

Private Sub Флажок2_Щелчок()
    Application.ScreenUpdating = False
    Dim LastRow&, tCell As Range
    ActiveSheet.UsedRange.Select
    LastRow = ActiveSheet.UsedRange.Rows.Count - 1 + ActiveSheet.UsedRange.Row
    For Each tCell In Range(Cells(1, 1), Cells(LastRow, 1))
        If tCell.Value = "СКРЫТЬ" And Cells(1, 3).Value Then
            tCell.Rows.Hidden = True
        Else
            tCell.Rows.Hidden = False
        End If
    Next tCell
    Application.ScreenUpdating = True
End Sub

[Alex_ST]

Poltava,
да, я тоже к вечеру совсем забыл про не верное определение номера последней строки с помощью End(xlUp) при скрытых строках...
Так что Вам тоже +1 за внимательность
Но и делать, как Вы предлагаете:

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

ActiveSheet.UsedRange.Selectперед назначением

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

LastRow = ActiveSheet.UsedRange.Rows.Count - 1 + ActiveSheet.UsedRange.Rowсовершенно излишне, т.к. достаточно простого обращения к дочерним объектам UsedRange чтобы этот диапазон правильно переопределился.
Поэтому мой (исправленный Ваш) вариант я бы записал так:

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

Sub Флажок2_Щелчок()
    Application.ScreenUpdating = False
    Dim rCell As Range
    With ActiveSheet
        For Each rCell In Range(.Cells(1, 1), .Cells(.UsedRange.Cells.SpecialCells(xlLasrCell).Row, 1))
            rCell.Rows.Hidden = rCell.Value = "СКРЫТЬ" And .Cells(1, 3).Value
        Next rCell
    End With
    Application.ScreenUpdating = True
End Sub

[Wasilic]

И так работает! 

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

Sub Флажок2_Щелчок()
    Application.ScreenUpdating = False
    If Range("C1").Value = True Then
       For I = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
           If Cells(I, 1).Value = "СКРЫТЬ" Then Rows(I).Hidden = True
       Next
    Else
       Rows("1:65000").Hidden = False
    End If
    Application.ScreenUpdating = True
End Sub


[Poltava]

...совершенно излишне...

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

И так работает!

Да но если у пользователя будет 2007 ексель и данные будут за пределами 65000 строк вот тогда не сработает.

[Wasilic]

Да но если у пользователя будет 2007 ексель и данные будут за пределами 65000 строк вот тогда не сработает.

А разве в 2007-м "65000" нельзя в макросе заменить на другое число? Сколько там у него? 650 000? 

[grits]

Дабы не плодить сущности (темы) решил свой вопрос задать тут, т.к. по теории он близок.

Цель: Создать форму в которой будут контролироваться изменения на конкретном Листе в одной конкретной Ячейке, в нашем примере это окрашенные ячейки столбца "U" строки 1, 12, 18.

При совпадении контрольного значения (к примеру Лист "Анкета" в ячейке U1 "Поручитель есть") таблица 1, находящаяся под ней отображается, а при не совпадении контрольного значения ("Поручитель отсутствует") таблица 1 скрывается.

Ячейки U12 и U18 контролируются тем же образом, при наличии "да" в них, таблицы 2 и 3 отображаются, при несовпадении значения ("нет") скрываются.

Начал было с азов с использования "Worksheet_Change", но прорукоблудствовав 2 выходных - ничего не вышло... взываю о помощи... заранее спасибо...

это остатки рукоблудия, в которых я не сомневаюсь 

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


Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address <> Range("U1").Address Then Exit Sub
    Application.ScreenUpdating = False



    Application.ScreenUpdating = True

End Sub

[Alex_ST]

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

Private Sub Worksheet_Change(ByVal Target As Range)
   Range("A2:A11").EntireRow.Hidden = Range("U1") <> "Поручитель есть"
   Range("A13:A17").EntireRow.Hidden = Range("U12") <> "да"
   Range("A19:A21").EntireRow.Hidden = Range("U18") <> "да"
End Sub


[grits]

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

Private Sub Worksheet_Change(ByVal Target As Range)
  Range("A2:A11").EntireRow.Hidden = Range("U1") <> "Поручитель есть"
  Range("A13:A17").EntireRow.Hidden = Range("U12") <> "да"
  Range("A19:A21").EntireRow.Hidden = Range("U18") <> "да"
End Sub


ну, что тут скажешь....стыдно мне... спасибо Вам, Алексей...

ps *уполз читать VB Documentation*

[grits]

И все же...

Алексей, насколько я смог понять из документации, то при таком написании кОда, будут отслеживаться ЛЮБЫЕ изменения на листе...
Поэтому, когда вводишь любые-другие данные на листе, по нажатию Enter лист как бы передергивает на предмет поиска соответствий...

Не могли бы вы подсказать как при помощи If Target.Address <> Range("U1").Address Then Exit Sub отслеживать изменения ТОЛЬКО в конкретных ячейках на листе, чтобы не было этого неприятного передергивания...
Поправьте меня пожалуйста:

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


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> Range("U1", "U12", "U18").Address Then Exit Sub
   Range("A2:A11").EntireRow.Hidden = Range("U1") <> "Поручитель есть"
   Range("A13:A17").EntireRow.Hidden = Range("U12") <> "да"
   Range("A19:A21").EntireRow.Hidden = Range("U18") <> "да"
End Sub


[Alex_ST]

Не понимаю, чем Вам мешает регулярное обновление данных на листе...
Но если всё-таки мешает, то попробуйте сделать так:

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

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("U1"), Range("U12"), Range("U18")) Is Nothing Then Exit Sub
   Range("A2:A11").EntireRow.Hidden = Range("U1") <> "Поручитель есть"
   Range("A13:A17").EntireRow.Hidden = Range("U12") <> "да"
   Range("A19:A21").EntireRow.Hidden = Range("U18") <> "да"
End Sub
или так:

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

Private Sub Worksheet_Change(ByVal Target As Range)
   Select Case Target.Address(0, 0)
      Case "U1": Range("A2:A11").EntireRow.Hidden = Range("U1") <> "Поручитель есть"
      Case "U12": Range("A13:A17").EntireRow.Hidden = Range("U12") <> "да"
      Case "U18": Range("A19:A21").EntireRow.Hidden = Range("U18") <> "да"
   End Select
End Sub

[Poltava]

Вот так тоже можно ссылаться на не смежные ячейки

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

......Range("U1, U12, U18").......

[Alex_ST]

Вот так тоже можно ссылаться на не смежные ячейки

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

......Range("U1, U12, U18").......

Согласен. Первый вариант написал по инерции, не продумав... 
Тогда так:

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

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("U1", "U12", "U18")) Is Nothing Then Exit Sub
   Range("A2:A11").EntireRow.Hidden = Range("U1") <> "Поручитель есть"
   Range("A13:A17").EntireRow.Hidden = Range("U12") <> "да"
   Range("A19:A21").EntireRow.Hidden = Range("U18") <> "да"
End Sub