Excel VBA：为什么我的宏生成的图纸越多，速度就越慢？

正如昨天所建议的，我将我的问题分为两部分，尽管我认为它们可能有联系：

我有一个Excel宏，基本上可以工作，但是宏添加的工作表越多，速度就越慢。 它最多可以创建几百张表，每一张表都是不同的报告，所以我必须保留所有的表。 开始时，10张纸大约需要10秒，但在70/80张左右时，时间几乎是原来的三倍。 这仅仅是因为纸张的数量，还是我可以再次加快速度

代码有点长，因此我将其缩减以解决此问题，并在代码中对其进行了标记：

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
'->Issue: It takes around 10 seconds to fill 10 sheets with the reports of 10 agents.
'When I reach 70-80 sheets, it slows down to 30 seconds for 10 sheets.
'Is this just because of the number of sheets, or can I speed it up again?

    .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

 Application.Wait (Now + TimeValue("0:00:01"))

    'Continue with other stuff.... sorting sheets and so on

Next

    Application.ScreenUpdating = True

End Sub

---

对这个问题有什么想法吗？

我看到你在把一些内容从一些页面复制粘贴到另一个页面。这里的关键是——这些范围内有公式吗？如果使用公式添加越来越多的范围，由于没有禁用自动计算，每次需要重新计算时，计算速度都会变慢。我没有关闭它，因为我需要计算来更新新代理的报告。之后，我将所有公式的值替换为“ActiveSheet.UsedRange.Value=ActiveSheet.UsedRange.Value”。所以我认为这不是问题。