Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макросы. Скрыть столбцы по заданному условию. Скрыть строки по заданному условию., 2 макроса.
 
#1
24.10.2019 18:53:20
Для комфортной работы с большой таблицей (и по вертикали, и по горизонтали) следует придать ей компактный вид. Лучший вариант - это макросы: Скрыть/Показать. Причем, отдельный макрос на скрыть по столбцам и отдельный - на скрыть по строкам. Фильтром пользоваться крайне неудобно, т.к. данные меняются и запомнить в каких строках они есть крайне сложно, а постоянно прокручивать 4 тыс. строк утомительно.
Пример максимально сжат, условие - нулевое значение (если ноль - скрываем). В примере подробно расписано.
Собственно интересуют макросы на Скрыть, поэтому в описании указано - 2 макроса.
 
 
 
#2
24.10.2019 20:17:26
presentt, Можно так
Код
Sub Скрыть_Строки()
 Application.ScreenUpdating = False
 Dim c As Range, LRow As Long
 LRow = Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Range(Cells(3, 22), Cells(LRow, 22))
      If c = 0 Then
        c.EntireRow.Hidden = True
      End If
    Next
 Application.ScreenUpdating = True
End Sub

Sub Скрыть_Столбцы()
 Application.ScreenUpdating = False
 Dim c As Range, lCol As Long
 lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    For Each c In Range(Cells(1, 5), Cells(1, lCol))
      If c = 0 Then
        c.EntireColumn.Hidden = True
      End If
    Next
 Application.ScreenUpdating = True
End Sub
Изменено: casag - 24.10.2019 20:20:35
 
 
 
#3
25.10.2019 00:49:18
Спасибо! Со столбцами всё работает, скрывает правильно и открывает (раньше макрос давали).
А вот строками - не всё скрывает, 11, 12 и 13 остаются открытыми и макрос на открытие ругается:
Код
Sub
Показать_строки(): Cells.Hidden = False: End Sub
 
 
 
#4
25.10.2019 03:22:14
нужно исправлять макрос пока не перестанет ругаться
и вообще макрос, который не выполняет возложенную на него задачу это плохой макрос, у нас на курсах трактористов такие макрос называли "га...о-макрос"
Код
Sub Показать_строки()
  Rows.Hidden = False
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
25.10.2019 11:40:45
Добрый день. Не обратил внимания, что нужно скрывать блоками. Тогда так
Изменено: casag - 25.10.2019 12:59:03
 
 
 
#6
25.10.2019 16:28:06
Спасибо огромное, только маленькая просьба, пример был сжат и я полагал, что просто подправлю крайние значения в макросе и всё будет работать в большой таблице, но по строкам не идёт. крайний столбец (где итоги) имеет номер 122, макрос я подправил следующим образом:

Код
Sub
Скрыть_Строки()

Application.ScreenUpdating = False
 Dim c As Range, LRow As Long, a As Variant, v As Range

LRow = Cells(Rows.Count, 1).End(xlUp).Row
   
For Each v In Range(Cells(3, 122), Cells(LRow, 122))
    
 If v = 0 Then
    
    a = v.Offset(0, -119).Value
    
    For Each c In Range(Cells(3, 3), Cells(LRow, 3))
    
       If c = a Then
    
          c.EntireRow.Hidden = True
    
          End If
    
          Next
    
       End If
    
  Next

Application.ScreenUpdating = True
End Sub

Может что-то не так сделал?
И, просто интересно, макросы на скрыть и показать столбцы выполняется мгновенно, а вот на скрыть и показать строки - медленно (можно пару сигарет выкурить, пока считает).
Изменено: presentt - 25.10.2019 16:31:22
 
 
 
#7
25.10.2019 17:43:59
presentt, Попробуйте так.Должно быть быстрее.
Код
Sub СкрытьСтроки()
Application.ScreenUpdating = False
 Dim c As Range, LRow As Long, a As Variant, iCell As Range
LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Range(Cells(3, 122), Cells(LRow, 122))
  If c = 0 Then
      a = c.Offset(0, -119).Value
      Set iCell = Range(Cells(2, 3), Cells(LRow, 3)).Find(a)
      Rows(iCell.Row).Resize(4).EntireRow.Hidden = True
   End If
Next
Application.ScreenUpdating = True
End Sub
Изменено: casag - 25.10.2019 17:48:04
 
 
 
#8
25.10.2019 17:53:02
presentt, Удаление (скрытие) строк по условию
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#9
25.10.2019 18:05:12
Спасибо! Всё работает, и стало реально быстрее. Файл примера мгновенно срабатывает, а мой большой чуток подтормаживает, но не критично. Спасибо, ещё раз.
 
 
 
Страницы: 1
Наверх