Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

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

Автор DMaksimov, 19.10.2012, 11:35

« назад - далее »

DMaksimov

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

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

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

Poltava

Не пытайтесь спорить с дебилом. Иначе вы опуститесь до его уровня. Где он задавит вас своим опытом.

Alex_ST

#2
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

Цитата: Poltava от 22.10.2012, 01:19
Да но если у пользователя будет 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

Цитата: Alex_ST от 22.10.2012, 12:50
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

#12
Не понимаю, чем Вам мешает регулярное обновление данных на листе...
Но если всё-таки мешает, то попробуйте сделать так: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

Цитата: Poltava от 22.10.2012, 15:25
Вот так тоже можно ссылаться на не смежные ячейки
......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

С уважением, Алексей