Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Скрытие строк по нулевому значению ячеек - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скрытие строк по нулевому значению ячеек (Макросы/Sub)
Скрытие строк по нулевому значению ячеек
Screamer08 Дата: Понедельник, 31.03.2014, 14:48 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Всем привет!

Я нашел макрос и подстроил немного под себя, который скрывает строки если есть нулевые значения ячеек в выделенном диапазоне.
Код выглядит так:
[vba]
Код
Sub OpenRowsByZero()
'Update 20131107
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
If Rng.Value = "0" Then
Rng.EntireRow.Hidden = Ture
End If
Next
End Sub
[/vba]

Соответственно меняя True на False открываю этот диапазон.
Использую этот макрос для автоматизации соответственно, так как много нулевых ячеей в таблице появляется, а группировать напряжно все.
Но проблема в том что он очень долго скрывает ячейки, делает каждую поочередно и на одну он тратит там меньше чем пол секунды, соответственно если у меня 700 позиций, то он будет скрывать их несколько минут, ну и подвисает из-за этого сам эксель. %)
Есть ли более простой способ это сделать? Или как то ускорить процесс обработки ячеек макросом?
Заранее спасибо! :)
 
Ответить
СообщениеВсем привет!

Я нашел макрос и подстроил немного под себя, который скрывает строки если есть нулевые значения ячеек в выделенном диапазоне.
Код выглядит так:
[vba]
Код
Sub OpenRowsByZero()
'Update 20131107
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
If Rng.Value = "0" Then
Rng.EntireRow.Hidden = Ture
End If
Next
End Sub
[/vba]

Соответственно меняя True на False открываю этот диапазон.
Использую этот макрос для автоматизации соответственно, так как много нулевых ячеей в таблице появляется, а группировать напряжно все.
Но проблема в том что он очень долго скрывает ячейки, делает каждую поочередно и на одну он тратит там меньше чем пол секунды, соответственно если у меня 700 позиций, то он будет скрывать их несколько минут, ну и подвисает из-за этого сам эксель. %)
Есть ли более простой способ это сделать? Или как то ускорить процесс обработки ячеек макросом?
Заранее спасибо! :)
Автор - Screamer08
Дата добавления - 31.03.2014 в 14:48
igrtsk Дата: Понедельник, 31.03.2014, 15:58 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 314
Репутация: 50 ±
Замечаний: 0% ±

Excel 2016
Есть способ несколько ускорить процесс. Следует отключить перерисовку страниц:

[vba]
Код
Application.ScreenUpdating = False 'отключение перерисовки окна
ActiveSheet.DisplayPageBreaks = False  'отключение перерисовки границ страниц

Application.ScreenUpdating = True 'включение перерисовки окна
ActiveSheet.DisplayPageBreaks = True  'включение перерисовки границ страниц
[/vba]

Добавить в начале и в конце макроса

Инструктор по применению лосей в кавалерийских частях РККА

Сообщение отредактировал igrtsk - Понедельник, 31.03.2014, 15:59
 
Ответить
СообщениеЕсть способ несколько ускорить процесс. Следует отключить перерисовку страниц:

[vba]
Код
Application.ScreenUpdating = False 'отключение перерисовки окна
ActiveSheet.DisplayPageBreaks = False  'отключение перерисовки границ страниц

Application.ScreenUpdating = True 'включение перерисовки окна
ActiveSheet.DisplayPageBreaks = True  'включение перерисовки границ страниц
[/vba]

Добавить в начале и в конце макроса
Автор - igrtsk
Дата добавления - 31.03.2014 в 15:58
nilem Дата: Понедельник, 31.03.2014, 15:59 | Сообщение № 3
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
можно попробовать так
[vba]
Код
Sub OpenRowsByZero()
Dim rHide As Range, xTitleId As String, Rng As Range, WorkRng As Range
xTitleId = "KutoolsforExcel"
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set rHide = WorkRng(1, WorkRng.Columns.Count + 1)
For Each Rng In WorkRng
     If Rng.Value = 0 Then    'или все-таки "0"
         Set rHide = Union(rHide, Rng)
     End If
Next
If rHide.Count > 1 Then Intersect(rHide, WorkRng).EntireRow.Hidden = True
End Sub
[/vba]

Яндекс.Деньги 4100159601573
 
Ответить
Сообщениеможно попробовать так
[vba]
Код
Sub OpenRowsByZero()
Dim rHide As Range, xTitleId As String, Rng As Range, WorkRng As Range
xTitleId = "KutoolsforExcel"
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set rHide = WorkRng(1, WorkRng.Columns.Count + 1)
For Each Rng In WorkRng
     If Rng.Value = 0 Then    'или все-таки "0"
         Set rHide = Union(rHide, Rng)
     End If
Next
If rHide.Count > 1 Then Intersect(rHide, WorkRng).EntireRow.Hidden = True
End Sub
[/vba]
Автор - nilem
Дата добавления - 31.03.2014 в 15:59
Screamer08 Дата: Понедельник, 31.03.2014, 16:47 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Цитата igrtsk, 31.03.2014 в 15:58, в сообщении № 2
Есть способ несколько ускорить процесс. Следует отключить перерисовку страниц:

Application.ScreenUpdating = False 'отключение перерисовки окна
ActiveSheet.DisplayPageBreaks = False  'отключение перерисовки границ страниц

Application.ScreenUpdating = True 'включение перерисовки окна
ActiveSheet.DisplayPageBreaks = True  'включение перерисовки границ страниц

Добавить в начале и в конце макроса


Спасибо! Действительно работает, делает теперь ощутимо быстрее ну и без прорисовки. В принципе это подойдет вообще! Но все равно немного торможение есть. Хотелось бы узнать может есть еще какой-нибудь способ?
И заметил еще, делаю так как Вы написали, но у меня не включается обновление экрана. Вставляю значение с True в конец, все как написано. В чем подвох? И как теперь заново включить обновление страницы, так как когда значения формулы, не меняются значения в зависящих ячейках, только после выделения их в формуле?

Цитата nilem, 31.03.2014 в 15:59, в сообщении № 3
можно попробовать так
Sub OpenRowsByZero()
Dim rHide As Range, xTitleId As String, Rng As Range, WorkRng As Range
xTitleId = "KutoolsforExcel"
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set rHide = WorkRng(1, WorkRng.Columns.Count + 1)
For Each Rng In WorkRng
If Rng.Value = 0 Then    'или все-таки "0"
Set rHide = Union(rHide, Rng)
End If
Next
If rHide.Count > 1 Then Intersect(rHide, WorkRng).EntireRow.Hidden = True
End Sub


Ваш почему-то не заработал, просто молчит при использовании, ну подгружается но без изменений все.
Ваш заработал, все круто! Но теперь вопрос, как открывать скрывшиеся ячейки? А то сам не могу въехать!
Уже разобрался :D Все заработало довольно круто, очень быстро скрывает, пару секунд где-то hands

Когда-то просто видел макрос в примере что делал такую же функцию, но не смог адаптировать под себя, так как не силен в VBA, так там задача выполнялась мгновенно. Было бы круто какие-то обходные варианты посмотреть!

Спасибо за ответы, ребята!


Сообщение отредактировал Screamer08 - Понедельник, 31.03.2014, 19:13
 
Ответить
Сообщение
Цитата igrtsk, 31.03.2014 в 15:58, в сообщении № 2
Есть способ несколько ускорить процесс. Следует отключить перерисовку страниц:

Application.ScreenUpdating = False 'отключение перерисовки окна
ActiveSheet.DisplayPageBreaks = False  'отключение перерисовки границ страниц

Application.ScreenUpdating = True 'включение перерисовки окна
ActiveSheet.DisplayPageBreaks = True  'включение перерисовки границ страниц

Добавить в начале и в конце макроса


Спасибо! Действительно работает, делает теперь ощутимо быстрее ну и без прорисовки. В принципе это подойдет вообще! Но все равно немного торможение есть. Хотелось бы узнать может есть еще какой-нибудь способ?
И заметил еще, делаю так как Вы написали, но у меня не включается обновление экрана. Вставляю значение с True в конец, все как написано. В чем подвох? И как теперь заново включить обновление страницы, так как когда значения формулы, не меняются значения в зависящих ячейках, только после выделения их в формуле?

Цитата nilem, 31.03.2014 в 15:59, в сообщении № 3
можно попробовать так
Sub OpenRowsByZero()
Dim rHide As Range, xTitleId As String, Rng As Range, WorkRng As Range
xTitleId = "KutoolsforExcel"
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set rHide = WorkRng(1, WorkRng.Columns.Count + 1)
For Each Rng In WorkRng
If Rng.Value = 0 Then    'или все-таки "0"
Set rHide = Union(rHide, Rng)
End If
Next
If rHide.Count > 1 Then Intersect(rHide, WorkRng).EntireRow.Hidden = True
End Sub


Ваш почему-то не заработал, просто молчит при использовании, ну подгружается но без изменений все.
Ваш заработал, все круто! Но теперь вопрос, как открывать скрывшиеся ячейки? А то сам не могу въехать!
Уже разобрался :D Все заработало довольно круто, очень быстро скрывает, пару секунд где-то hands

Когда-то просто видел макрос в примере что делал такую же функцию, но не смог адаптировать под себя, так как не силен в VBA, так там задача выполнялась мгновенно. Было бы круто какие-то обходные варианты посмотреть!

Спасибо за ответы, ребята!
Автор - Screamer08
Дата добавления - 31.03.2014 в 16:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скрытие строк по нулевому значению ячеек (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!