excel - VBA:为什么暂停我的宏会使其更快?
问题描述
正如昨天建议的那样,我将我的问题分成两部分,尽管我认为它们可能是相关的:
我有一个基本上可以工作的 Excel 宏,但是宏添加的工作表越多,它就越慢。当我只创建几张(〜100)它没关系,但有时它会创建多达几百张,每张都是不同的报告,我必须保留所有的表。然后问题开始了。
在宏创建所有这些工作表之后,我会做一些事情,比如对打印进行排序。但在宏继续执行此任务之前,它需要很长时间,具体取决于我刚刚生产了多少张。
几年前,我遇到了一个缓慢的宏问题。然后我找到了强制暂停的提示。我用这个宏再次尝试过,它把速度提高了很多时间。暂停如何加速宏?
代码有点长,所以我减少了它以解决问题并在代码中标记它:
Sub My_Issues()
Dim ColumnLetter As String, item As String
Dim cell As Range
Dim sheetCount As Integer, TotalRow As Integer, TotalCol As Integer
Dim uniqueArray As Variant
Dim lastRow As Long, x As Long
Application.ScreenUpdating = False
'Get unique brands:
With Sheets("Brand")
.Columns(1).EntireColumn.Delete
Sheets("Sales").Columns("R:R").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If .Range("A3:A" & lastRow).Cells.Count = 1 Then
ReDim uniqueArray(1, 1)
uniqueArray(1, 1) = .Range("A3")
Else
uniqueArray = .Range("A3:A" & lastRow).Value
End If
End With
TotalRow = Sheets("Sales").UsedRange.Rows.Count
TotalCol = Sheets("Sales").UsedRange.Columns.Count
ColumnLetter = Split(Cells(1, TotalCol).Address, "$")(1) 'Num2Char
sheetCount = 0 'Counter for statusbar
For x = 1 To UBound(uniqueArray, 1)
item = uniqueArray(x, 1) 'item=Brand
'Filter sales for each brand:
With Sheets("Sales")
.Range(.Cells(2, 1), .Cells(TotalRow, TotalCol)).AutoFilter Field:=18, Criteria1:=item
End With
With Sheets("Agents")
'Delete old...
.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Clear
'...and get new
Sheets("Sales").Range(Sheets("Sales").Cells(3, 2), Sheets("Sales").Cells(2, 2).End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
.Range("A2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
'List with all agents
For Each cell In Worksheets("Agents").Range("A2", Worksheets("Agents").Range("A1").End(xlDown))
With Sheets("Report")
.Range("I4") = cell 'Copy agent and update the formulas within the report
.Range(.PageSetup.PrintArea).Copy
Sheets.Add After:=Sheets("Report")
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'Replace all formulas with values
Application.CutCopyMode = False
ActiveSheet.Name = cell
sheetCount = sheetCount + 1
If sheetAnz Mod 10 = 0 Then Application.StatusBar = sheetAnz 'Get statusupdate every 10 sheets
End With
Next
'->Issue: I create up to 400 sheets and when I want to continue and do some sorting of the sheets for example it takes a very long time.
'But if I add this break for a second, it works reasonably fine again. Why is that? Does vba needs the break to catch up with itself?
'Since the issue is not the sorting and the other stuff after the pause.
Application.Wait (Now + TimeValue("0:00:01"))
'Continue with other stuff.... sorting sheets and so on
Next
Application.ScreenUpdating = True
End Sub
关于这个问题的任何想法?