如何优化特定的vba代码速度?

时间:2015-08-10 11:12:59

标签: excel vba excel-vba

我们使用这个VBA代码主要隐藏空白行和&取消隐藏非空行,然后在激活工作表后,第二个代码按行定义的行对行进行排序。这个过程花了太多时间使用这段代码,任何人都可以帮我优化这段代码并加快速度吗? (工作表平均包含500行)。

Private Sub Worksheet_Activate()
HideRows
Sortingrisk
End Sub

Sub HideRows()
Dim rRange As Range, rCell As Range
Dim strVal As String

   Set rRange = Worksheets(12).Range("A10:A500")

    For Each rCell In rRange
      strVal = rCell
      rCell.EntireRow.Hidden = strVal = vbNullString
    Next rCell
End Sub

Sub Sortingrisk()

    ActiveWorkbook.Worksheets("Control Implementation Plan").AutoFilter.Sort. _
      SortFields.Clear
   ActiveWorkbook.Worksheets("Control Implementation Plan").AutoFilter.Sort. _
      SortFields.Add Key:=Range("G10:G1000"), SortOn:=xlSortOnValues, Order:= _
      xlDescending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("Control Implementation Plan").AutoFilter.Sort
     .Header = xlYes
      .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
    End With
End Sub

4 个答案:

答案 0 :(得分:1)

Sub

的开头插入此内容
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

这就在End Sub

之前
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

答案 1 :(得分:1)

试试这个:

Worksheets(12).Range("A10:A500").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

答案 2 :(得分:0)

你的HiddenRows需要永恒。试试

Sub HideRows()
    Worksheets(12).Range("A10:A500").Hidden = True
End Sub

答案 3 :(得分:0)

从编程角度来看,您应该隐藏整个范围而不使用循环。您还可以优化运行时环境,首先应用程序属性。

通常

Application.ScreenUpdating = False

是加速处理电子表格内容的宏的最重要的一条线。

其次是

Application.Calculation = xlCalculationManual

如果您的宏触发重新计算,这可能很有用。我总是犹豫从自动改变计算状态,因为如果宏发生故障,你可能会将电子表格留在手动模式下,这可能非常危险,特别是如果其他不了解宏的人正在使用它

我不会禁用DisplayStatusBar或EnableEvents。对于速度而言,你的立场很少,而且功能也很多。

以下是您的代码简化了一些示例并使用手动计算状态的示例,该状态将在非致命错误时安全地重置为自动。您可能需要考虑删除手动状态或构建其他错误处理。

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideRows Me
SortingRisk Range("G10:G1000")
End Sub
Sub HideRows(ByRef w As Worksheet)
w.Range("A10:A500").Rows.Hidden = True
End Sub
Sub SortingRisk2(ByRef R As Range)
Application.Calculation = xlCalculationManual
On Error GoTo term
Dim F As AutoFilter
With R.Worksheet
    If .AutoFilter Is Nothing Then
        R.AutoFilter
    End If
    Set F = R.Worksheet.AutoFilter
    F.Sort.SortFields.Clear
End With

With F.Sort
    .SortFields.Add _
       Key:=R, _
       SortOn:=xlSortOnValues, _
       Order:=xlDescending, _
       DataOption:=xlSortNormal
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

term:
Application.Calculation = xlAutomatic
If Err > 0 Then
    MsgBox "Error: Macro has terminated. Verify that Workbook Calculation
state is in auto."
End If
End Sub