Excel vba скрывает пустые строки без фильтра

Я использую этот код для создания нового листа и перечисляю все имена листов в книге с пустыми строками между ними, а затем скрывает все пустые строки между именем листа.

Но его принятие более чем на минуту для завершения – это более эффективный способ сделать это?

Sub ListAllSheetNames() 'Disabling the following to speed up the vba code ActiveSheet.DisplayPageBreaks = False Application.EnableEvents = False Application.ScreenUpdating = False Application.DisplayAlerts = False 'code to create new sheet and list all sheet names in workbook Dim xWs As Worksheet On Error Resume Next xTitleId = "All Sheet Names" Application.Sheets(xTitleId).Delete Application.Sheets.Add.Index Set xWs = Application.ActiveSheet xWs.Name = xTitleId For i = 2 To Application.Sheets.Count 'Edit this to adjust the row spacing, number after * xWs.Range("A" & ((i - 2) * 18) + 1) = Application.Sheets(i).Name Next 'Hides all empty rows Set Rng = Range("A1", Range("A15000").End(xlUp)) For Each cel In Rng If Not cel.Value > 0 Then cel.EntireRow.Hidden = True End If Next cel Range("A1").Select 'UnDisabling ActiveSheet.DisplayPageBreaks = True Application.EnableEvents = True Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

Вместо подхода грубой силы:

 For Each cel In Rng If Not cel.Value > 0 Then cel.EntireRow.Hidden = False End If Next cel 

Вы должны быть в состоянии сделать просто:

 Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 

Использование SpecialCells(xlCellTypeBlanks) должно быть почти мгновенным (хотя даже в моих тестах потребовалось всего несколько секунд, чтобы выполнить итерацию грубой силы).

Проблема в том, что в каждой строке есть 16384 ячейки, и вы выполняете итерацию через 16384 * (Sheet Count - 1) * 18 ячеек

 For Each cel In Rng If Not cel.Value > 0 Then cel.EntireRow.Hidden = True End If Next cel 

Это лучше

 For Each rw In Rng.Rows If Not rw.Cells(1,1).Value > 0 Then rw.Hidden = True End If Next rw 

Я бы спрятал строки, когда добавляю имена листов:

 Sub ListAllSheetNames() Const xTitleId = "All Sheet Names" Application.ScreenUpdating = False 'code to create new sheet and list all sheet names in workbook Dim xWs As Worksheet, ws As Worksheet Dim i As Long On Error Resume Next DeleteWorksheet xTitleId Application.Sheets.Add Set xWs = Application.ActiveSheet xWs.Name = xTitleId i = 1 For Each ws In Sheets xWs.Cells(i, 1).Value = ws.Name xWs.rows(i + 1).Resize(17).Hidden = True i = i + 18 Next Range("A1").Select Application.ScreenUpdating = True End Sub Sub DeleteWorksheet(SheetName As String) Application.DisplayAlerts = False 'Resets when the Sub Exits On Error Resume Next 'Resets when the Sub Exits Sheets(SheetName).Delete End Sub 
Interesting Posts

Ошибка 0x800A03EC добавление Slicer в сводную таблицу с использованием interop excel

ошибка времени выполнения 5981 в Office / excel 2010 новая установка

Создайте формулу в столбце excel, чтобы все готовые имели на ней формулу

Случайно заполните таблицу из 25 значений, которые поступают из набора из 30 значений?

Мой код vba не зацикливается до моего желаемого номера. но если я положил его в excel и использовал решатель, он работает

Экспортируйте HighChart как изображение в файле excel вместе с другим содержимым страницы

Laravel phpExcel Maatwebsite, конфигурационный разделитель и корпус не работают

Перемещение ячеек на другой лист на основе текстовой строки с использованием VB (excel)

Преобразование Word docx в Excel с помощью OpenXML

Перерыв строки в дочерний и родительский столбцы в excel

windows.visible = false, предотвращающий использование именованного диапазона

Импорт / обновление данных из Excel в SQL Server

Удаление столбцов (ов) из выбранного диапазона

экранирование с кодом рабочей программы

Target.Address с выпадающим значением

Давайте будем гением компьютера.