我没有做太多的VBA，并且相对来说还比较陌生。 当前的以下VBA运行时间过长，需要5分钟！
有人可以提供建议以加快速度吗？我已经添加了一些东西。我认为这主要是由于文档中的数据量所致。我大约有20个带有数据的选项卡，并且该宏必须贯穿所有可见的选项卡，但是我不知道如何编写代码来限制此范围。
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
答案 0 :(得分：0)
您可以尝试以下操作，在运行循环之前，我只是将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
答案 1 :(得分：0)
可以通过一步设置多列的列宽来提高宏速度。
例如class Order < ApplicationRecord
belongs_to :store
belongs_to :product
has_many :order_options, dependent: :destroy
has_many :options, through: :order_options
accepts_nested_attributes_for :order_options
end
class OrderOption < ApplicationRecord
belongs_to :option
belongs_to :order
accepts_nested_attributes_for :option
end
class Option < ApplicationRecord
belongs_to :product_category
has_many :order_options, dependent: :destroy
has_many :orders, through: :order_options
end
class ProductCategory < ApplicationRecord
belongs_to :store
has_many :products, dependent: :destroy
accepts_nested_attributes_for :products, allow_destroy: true
has_many :options, dependent: :destroy
accepts_nested_attributes_for :options, allow_destroy: true
end
Columns("A:J").ColumnWidth = 13.56答案 2 :(得分：0)
要进一步加快Xabier已经完成的工作的速度，您可以同时设置多个列宽。
有一些相同，因此将它们分组是一个好主意。
此外，您每次打开工作簿时是否真的需要执行此操作？我的意思是，如果您一次设置宽度，为什么下次打开工作簿时需要再次更改宽度？
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
If ws.Visible = True Then ' is worksheet visible?
ws.Columns("A").ColumnWidth = 0.94 'this line determines the column width
ws.Range("B:B,K:L").ColumnWidth = 6.56 'this line determines the column width
ws.Range("C:E,J:J").ColumnWidth = 13.56
ws.Range("F:F,H:I").ColumnWidth = 10.11
ws.Columns("G").ColumnWidth = 6.11
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
end if
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
这意味着它将用五行代码而不是12行更改所有列宽
您还可以先检查是否需要更改列宽。
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
If ws.Visible = True Then' is worksheet visible?
if ws.Columns("A").ColumnWidth <> 0.94 and ws.Range("B:B,K:L").ColumnWidth <> 6.56 and ws.Range("F:F,H:I").ColumnWidth <> 10.11 and ws.Columns("G").ColumnWidth <> 6.11 then
ws.Columns("A").ColumnWidth = 0.94 'this line determines the column width
ws.Range("B:B,K:L").ColumnWidth = 6.56 'this line determines the column width
ws.Range("C:E,J:J").ColumnWidth = 13.56
ws.Range("F:F,H:I").ColumnWidth = 10.11
ws.Columns("G").ColumnWidth = 6.11
end if
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
end if
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