首页 > 解决方案 > 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

关于这个问题的任何想法?

标签: excelvbaperformance

解决方案


推荐阅读