Как и предлагалось вчера, я делю свой вопрос на две части, хотя думаю, что они могут быть связаны:
У меня есть макрос Excel, который в основном работает, но он становится медленнее, когда добавляется больше листов макросом когда я создаю только несколько листов (~ 100), это нормально, но иногда создается до нескольких сотен листов, и каждый лист представляет собой отдельный отчет, и я должен сохранить все листы. Затем начинается проблема.
После того, как макрос создает все эти листы, я делаю такие вещи, как сортировка печати. Но прежде чем макрос продолжит выполнение этих задач, потребуется очень много времени, в зависимости от того, сколько листов я только что изготовил.
Несколько лет go У меня возникла проблема с медленным макросом. Тогда я нашел подсказку с вынужденной паузой. Я попробовал это с этим макросом снова, и это улучшило скорость на огромное количество времени. Почему пауза ускоряет макрос?
Код немного длиннее, поэтому я сократил его для решения проблемы и отметил его в коде:
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
Есть идеи по этому вопросу?