Question

我使用此代码创建一个新工作表，并列出工作簿中的所有工作表名称，它们之间有空行，然后它隐藏了工作表名称之间的所有空行。

但它接管了一分钟才能完成这项工作是否有更有效的方法？

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

Answer 1

而不是蛮力方法：

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)应该几乎是即时的（尽管在我的测试中，只需要几秒钟就可以进行暴力迭代）。

Answer 2

问题是每行有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

Excel vba隐藏空行而不使用过滤器

2 个答案:

我会在添加工作表名称时隐藏行：