时间戳

首页 > 解决方案 > 如何加快以下excel vba代码的速度？

excel - 如何加快以下excel vba代码的速度？

问题描述

我没有做很多 VBA 并且对这一切都比较陌生。以下 VBA 目前运行时间太长，需要 5 分钟！

有人可以提供建议以加快速度吗？我已经添加了一些东西。我认为这主要是由于我的文档中的数据量。我有大约 20 个带有数据的选项卡，并且宏必须遍历所有 VISIBLE 选项卡，但我不知道如何编写代码来限制这一点。

Sub Workbook_Open()

'-----START TIMER-----
Dim StartTime As Double
Dim TimeTaken As String
Dim ws As Worksheet

StartTime = Timer

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic
    ThisWorkbook.Date1904 = False
    Application.StatusBar = False

On Error Resume Next

'For Each ws In ActiveWorkbook.Worksheets ' Start of the VBA loop
For Each ws In Worksheets ' Start of the VBA loop
    With ws
    ws.Activate 'this part ensures each seperate tab is activated and the below code is run through
    Columns("A").ColumnWidth = 0.94 'this line determines the column width
    Columns("B").ColumnWidth = 6.56 'this line determines the column width
    Columns("C").ColumnWidth = 13.56
    Columns("D").ColumnWidth = 13.56
    Columns("E").ColumnWidth = 13.56
    Columns("F").ColxumnWidth = 10.11
    Columns("G").ColumnWidth = 6.11
    Columns("H").ColumnWidth = 10.11
    Columns("I").ColumnWidth = 10.11
    Columns("J").ColumnWidth = 13.56
    Columns("K").ColumnWidth = 6.56
    Columns("L").ColumnWidth = 6.56
    Wsh.Range("A1").Select 'this part ensure each worksheet view start position is A1
    ActiveWindow.View = xlPageBreakPreview 'Set Activesheet to Page Break Preview Mode
    ActiveWindow.Zoom = 114 'this line sets the permanent zoom % for all tabs
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    End With

Next ws
Application.Goto ThisWorkbook.Sheets("resume").Range("A1"), True 'starting position upon opening the file
'Worksheets(1).Activate 'this line make sure view is at first tab

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.Calculation = xlAutomatic
    ThisWorkbook.Date1904 = False
    ActiveWindow.View = xlNormalView

'------ END TIMER------
TimeTaken = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "Running time was " & TimeTaken & " (hours, minutes, seconds)"

End Sub

标签： excelvba

解决方案

您可以尝试以下操作，我只是在运行循环之前将 ScreenUpdating、EnableEvents 和 DisplayAlerts 修改为 False，然后在完成后将它们重置为 True：

Sub Workbook_Open()

'-----START TIMER-----
Dim StartTime As Double
Dim TimeTaken As String
Dim ws As Worksheet

StartTime = Timer

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

'For Each ws In ActiveWorkbook.Worksheets ' Start of the VBA loop
For Each ws In Worksheets ' Start of the VBA loop
        ws.Columns("A").ColumnWidth = 0.94 'this line determines the column width
        ws.Columns("B").ColumnWidth = 6.56 'this line determines the column width
        ws.Columns("C").ColumnWidth = 13.56
        ws.Columns("D").ColumnWidth = 13.56
        ws.Columns("E").ColumnWidth = 13.56
        ws.Columns("F").ColxumnWidth = 10.11
        ws.Columns("G").ColumnWidth = 6.11
        ws.Columns("H").ColumnWidth = 10.11
        ws.Columns("I").ColumnWidth = 10.11
        ws.Columns("J").ColumnWidth = 13.56
        ws.Columns("K").ColumnWidth = 6.56
        ws.Columns("L").ColumnWidth = 6.56
        ws.Range("A1").Select 'this part ensure each worksheet view start position is A1
        ActiveWindow.Zoom = 114 'this line sets the permanent zoom % for all tabs
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.ScrollRow = 1
Next ws


Application.Goto ThisWorkbook.Sheets("resume").Range("A1"), True 'starting position upon opening the file

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    ActiveWindow.View = xlNormalView

'------ END TIMER------
TimeTaken = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "Running time was " & TimeTaken & " (hours, minutes, seconds)"

End Sub

推荐阅读