Excel VBA隐藏3000行优化

我的第一个问题:)

在每次激活工作表时，都需要检查并隐藏3000行的工作表。

通常只有100行是可见的，但我必须确保它总是足够的线。 （以防万一）。

我有这个代码运行良好，但有点慢。 提示加速会很好。

Private Sub Worksheet_Activate() On Error GoTo ExitHandling Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'Hide Operations columns if no values If Worksheets("BasicData").Range("CheckOperationsZero").Value = "Yes" Then Columns("I:J").EntireColumn.Hidden = True Else Columns("I:J").EntireColumn.Hidden = False End If 'Hide empty rows, dont hide if row belowe is not empty, autofit for better viewing ActiveSheet.Rows("17:3017").EntireRow.Hidden = False For I = 3016 To 18 Step -1 If Application.WorksheetFunction.CountIf(Range("B" & I & ":J" & I), vbNullString) >= 9 And Application.WorksheetFunction.CountIf(Range("B" & I + 1 & ":J" & I + 1), vbNullString) >= 9 Then Rows(I).RowHeight = 12 Rows(I).EntireRow.Hidden = True Else Rows(I).EntireRow.AutoFit If Rows(I).Height < 20 Then Rows(I).RowHeight = 12 End If End If Next I ExitHandling: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Exit Sub ErrorHandling: MsgBox Err.Description Resume ExitHandling End Sub 

Answer 1

以下代码使用2个优化：
– 通过保存之前计算的值为下一次迭代计算每行的状态只有一次，而不是两次
– 收集一个范围对象中的所有空行，并一次对其进行格式化。 通过寻址“可见”单元格（通过SpecialCells）来格式化剩余的范围。

 Sub Worksheet_Activate() ' optimized for performance Const entireRange = "B17:J3017" Dim rowptr As Range Dim emptyrows As Range Dim I As Long Dim thisRowIsEmpty As Boolean, nextRowIsEmpty As Boolean On Error GoTo ExitHandling Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'Hide Operations columns if no values If Worksheets("BasicData").Range("CheckOperationsZero").Value = "Yes" Then Columns("I:J").EntireColumn.Hidden = True Else Columns("I:J").EntireColumn.Hidden = False End If 'Hide empty rows, dont hide if row belowe is not empty, autofit for better viewing Rows("17:3017").EntireRow.Hidden = False Set emptyrows = Cells(5000, 1) Set rowptr = Range("B3017:J3017") nextRowIsEmpty = Application.WorksheetFunction.CountIf(rowptr, vbNullString) >= 9 For I = 3016 To 18 Step -1 Set rowptr = rowptr.Offset(-1, 0) thisRowIsEmpty = Application.WorksheetFunction.CountIf(rowptr, vbNullString) >= 9 If thisRowIsEmpty And nextRowIsEmpty Then Set emptyrows = Application.Union(emptyrows, rowptr) End If nextRowIsEmpty = thisRowIsEmpty Next I If Not emptyrows Is Nothing Then With emptyrows .RowHeight = 12 .EntireRow.Hidden = True End With End If With Range(entireRange).SpecialCells(xlCellTypeVisible).EntireRow .AutoFit If .Height < 20 Then .RowHeight = 12 End If End With ExitHandling: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Exit Sub ErrorHandling: MsgBox Err.Description Resume ExitHandling End Sub 

在我的笔记本上，这个代码将运行在0.15 s而不是2.0 s，所以加速比大概是10：1。

Answer 2

这是我的一个老post。 如何在Word中使用VBA加速多个replace？

请记住最小化DOTS。

阅读这篇文章，因为它列出了4个性能杀手。

最小化点

所以如果你对性能感兴趣，最小化点（每个点都是查找），特别是在循环中。

有两种方法。 一个是设置对象到最低的对象，如果你要访问不止一次。

例如（较慢）

set xlapp = CreateObject("Excel.Application")

msgbox xlapp.worksheets(0).name

（更快，因为每次使用对象时都省略一个点）

set xlapp = CreateObject("Excel.Application")

set wsheet = xlapp.worksheets(0)

msgbox wsheet.name

第二种方法是with 。 一次只能有一个活动。

这跳过了100个查找。

with wsheet

For x = 1 to 100

  `msgbox .name` 

Next

end with