Страницы: 1
RSS
Сокрытие/показ строк на основании значений ячеек в отдельности друг от друга
 
Добрый день, подскажите пожалуйста, уже пол дня ломаю голову.
Прописал Private Sub для того, чтобы у меня скрывались или показывались строки в количестве, указанном в разных ячейках (на каждую ячейку по 11 строк, нужно лишь указать сколько из них показывать). Но сложилась проблема, что Excel делает это последовательно (кто бы мог подумать), как и прописано в коде. Ввиду этого, если я не меняю значение в первой ячейке, то и изменения в других ячейках не срабатывают. Для понимания, если я поменяю значение в ячейке С16, то количество строк не обновится, пока я не поменяю (или заново не пропишу) значение в ячейке С4.
Так вот вопрос в том, как лучше это сделать или прописать, с условием что таких блоков будет не 2, а намного больше, чтобы каждый блок работал автономно от других.
П. С. С основами VBA не знаком, пока делаю все на ощупь, как конструктор.
Изменено: Hitruga - 27.02.2024 10:59:18 (Замена документа на корректный с макросом)
 
Код
Sub HideShowRows()
    Dim nn As Long
    Dim flag As Boolean
    Dim cl As Range
    For Each cl In Columns(3).SpecialCells(xlCellTypeConstants, 1)
        If cl.Cells(2, 1).EntireRow.Hidden = True And flag = False Then
            Cells.EntireRow.Hidden = False
            Exit For
        Else
            flag = True
            nn = cl.Value
            If nn > 0 Then
                cl.Cells(2, 1).EntireRow.Resize(nn).Hidden = True
            End If
        End If
    Next
End Sub
 
Или так
Код
Sub HideShowRowsff()
Dim Rg1 As Range, Rg2 As Range, Tp1, i&, kRow&
Set Rg1 = ThisWorkbook.Worksheets(1).Cells(4, 1)
Set Rg2 = Rg1.CurrentRegion
Set Rg1 = Range(Rg1, Rg2.Cells(Rg2.Rows.Count, Rg2.Columns.Count))
Set Rg2 = Nothing
For Each Tp1 In Rg1.Columns(3).Cells
If Tp1.Value = vbNullString Then
i = i + 1
If i <= kRow Then If Rg2 Is Nothing Then Set Rg2 = Tp1 Else Set Rg2 = Union(Rg2, Tp1)
Else: kRow = Tp1.Value: i = 0
End If
Next
If Not Rg2 Is Nothing Then Rg2.EntireRow.Hidden = True
End Sub
Код
 
Цитата
написал:
Sub HideShowRows()
   Dim nn As Long
   Dim flag As Boolean
   Dim cl As Range
   For Each cl In Columns(3).SpecialCells(xlCellTypeConstants, 1)
       If cl.Cells(2, 1).EntireRow.Hidden = True And flag = False Then
           Cells.EntireRow.Hidden = False
           Exit For
       Else
           flag = True
           nn = cl.Value
           If nn > 0 Then
               cl.Cells(2, 1).EntireRow.Resize(nn).Hidden = True
           End If
       End If
   Next
End Sub
Данный макрос прячет указанное количество первых строк. Если я указываю, например - 2, то он показывает вместо 11-ти строк 9-ть, начиная с третьей
 
Цитата
написал:
Или так
Та же ситуация, что и с первым вариантом, предложенным тут. Макрос скрывает указанное количество строк из существующих 11-ти.
 
Не понятна проблема. Блоки по 11 строк скрываются и открываются блоки по столько строк, сколько указано в ячейке от от стрлки с этой ячейкой. По событию изменения сделать пробегая только по третьему столбцу со значениями. Мне видится код в строк так в 10.
Изменено: БМВ - 28.02.2024 08:11:43
По вопросам из тем форума, личку не читаю.
 
Цитата
написал:
Не понятна проблема. Блоки по 11 строк скрываются и открываются блоки по столько строк, сколько указано в ячейке от от стрлки с этой ячейкой. По событию изменения сделать пробегая только по третьему столбцу со значениями. Мне видится код в строк так в 10.
Проблема в том, как я и описывал, что в моей варианте (если вопрос про него) изменения согласно последующим значениям в столбце "С" осуществляются экселем только после внесения изменений в первое по порядку значение. Соответственно это не устраивает.
Если вопрос по предложенным вариантам, то там, видимо, подсчет идет с конца, т.к. при значении, к примеру, "3", остаются строки с 4 по 11, а не с 1 по 3 как задумано (сделал эти два примера на 2 и 3 листе соответственно, чтобы показать что я описываю)
 
Наверно опять не угадал. Ну все равно выложу.
Код
Sub HideShowRows1()
Dim cel As Range, Rg1 As Range, Rg2 As Range
Set Rg1 = Columns(3).SpecialCells(2, 1)
Set Rg2 = Range(Rg1, Rg1.CurrentRegion.Cells(Rg1.CurrentRegion.Cells.Count))
If Rg2.Cells.Count <> Rg2.SpecialCells(12).Cells.Count Then Rows.Hidden = False: Exit Sub
Rg2.EntireRow.Hidden = True
For Each cel In Rg1.Cells
If cel.Value Then cel.EntireRow.Resize(cel.Value + 1).Hidden = False
Next
End Sub
 
Цитата
написал:
Наверно опять не угадал. Ну все равно выложу.
Спасибо, да этот макрос работает согласно нужному принципу. Только вот, чтобы оставались только нужные строки, приходиться дважды нажимать на кнопку (в первый раз макрос возвращает все строки, а во второй уже оставляет нужные, согласно ячейкам). Поэтому буду думать как это сделать, чтобы эксель это делал автоматически, при изменении значений ячеек, а не через кнопку
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect([C3], Target) Is Nothing Then
Exit Sub
Else

Dim cel As Range, Rg1 As Range, Rg2 As Range
Set Rg1 = Columns(3).SpecialCells(2, 1)
Set Rg2 = Range(Rg1, Rg1.CurrentRegion.Cells(Rg1.CurrentRegion.Cells.Count))
If Rg2.Cells.Count <> Rg2.SpecialCells(12).Cells.Count Then Rows.Hidden = False: Exit Sub
Rg2.EntireRow.Hidden = True
For Each cel In Rg1.Cells
If cel.Value Then cel.EntireRow.Resize(cel.Value + 1).Hidden = False
Next
End Sub

Иду путем новичка, решил объединить два кода, получилось добиться, чтобы не через кнопку работало. Но вот снова код идет последовательно, и пока не исправлено первое значение в столбце "С", остальные не обновляются.

Грешу на:
"Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect([C3], Target) Is Nothing Then"

Но не могу допетрить чем заменить лучше, чтобы каждый диапазон строк после каждого значения ячеек "С" обновлялся обособлено от других значений, особенно первого
 
Tак.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell as Range
Application.ScreenUpdating = False
If Not Intersect(Columns(3), Target) Is Nothing Then
For Each Cell In Intersect(Columns(3), Target)
Cell.EntireRow.Resize(12).Hidden = True
Cell.EntireRow.Resize(Cell + 1).Hidden = False
Next
End If
Application.ScreenUpdating = True
End Sub
По вопросам из тем форума, личку не читаю.
 
Цитата
написал:
Tак.
Огонь, спасибо большое за помощь, действительно помогло
 
Hitruga, я б наверно  проверку на отрицательное число ввел, а то будет ошибка и останется скрытым набор групп.
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх