VBA: Почему приостановка моего макроса делает его быстрее? - PullRequest
0 голосов
/ 04 марта 2020

Как и предлагалось вчера, я делю свой вопрос на две части, хотя думаю, что они могут быть связаны:

У меня есть макрос 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

Есть идеи по этому вопросу?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...