Ускорение макроса, который проходит через листы перезаписи рабочей книги по значению

Question

Я создал макрос Excel VBA, который проходит по листу книги за листом, и если лист не содержит сводок, он будет перезаписывать его по значению. К сожалению, по крайней мере на одной рабочей книге это занимает так много времени, что я могу самостоятельно просмотреть каждый лист. Мне интересно, что нужно сделать, чтобы ускорить его. Кто-нибудь может подсказать, что мне нужно для этого сделать?

' Convert entire workbook's worksheets to values
'
Sub workbook_overrideSheetsToValues_noSave()
    Dim answer As Long, c  As Long, ws As Worksheet, report As String

    answer = MsgBox("Overwrite formulas in this workbook?", vbYesNo + vbQuestion, "Warning! Formula overwrite!")
    If answer = vbNo Then Exit Sub

    For Each ws In Worksheets
        ' only copy over by value if there aren't any pivot tables in the sheet.
        If ws.PivotTables.count = 0 Then
            Call copySheetByValue(ws.Name)
        ' save all sheets being skipped
        Else
            c = c + 1
            report = report & Chr(10) & c & ".    " & ws.Name
        End If
    Next ws

    If report <> "" Then Call MsgBox("Sheets with pivots were skipped:" & report, 0, "Warning!")
End Sub


Sub copySheetByValue(sheetName As Variant, Optional cellPos As String = "A1")
    Dim vFlag As Boolean

    ' Handle case where sheet is hidden
    If sheets(sheetName).Visible = False Then
        sheets(sheetName).Visible = True
        vFlag = True
    End If

    Worksheets(sheetName).Unprotect

    On Error Resume Next
    Worksheets(sheetName).ShowAllData  ' Clear filters on all columns
    Worksheets(sheetName).Cells.EntireColumn.Hidden = False ' Unhide all columns
    On Error GoTo 0

    Worksheets(sheetName).Cells.Copy
    Worksheets(sheetName).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.Goto Worksheets(sheetName).Range(cellPos)

    ' Hide sheet if it was unhidden above
    If vFlag = True Then
        sheets(sheetName).Visible = False
        vFlag = False
    End If
End Sub

Рабочая тетрадь, в которой она работает очень медленно, содержит 27 таблиц, 12 из которых содержат стержни. Каждая из 15 оставшихся имеет менее 1000 строк, за исключением одной, содержащей 24000. Выполнение Ctrl-A, Ctrl-C, а затем вставка по значению занимает только одну минуту, когда выполняется вручную.

Answer 1

Бен,

Прежде всего, нужно добавить несколько элементов управления, чтобы убедиться, что Excel не позволяет вычислять вещи:

Application.ScreenUpdating=False
Application.Calculation = xlCalculationManual 'xlCalculationAutomatic to revert back
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
Application.StatusBar = False

Затем вы сделали замечательную вещь, используя Worksheets(sheetName), чтобы убедиться, что ваш код действительно выполняется на хорошем рабочем листе, но вы должны действительно заключить его в блок With, чтобы избежать кода, чтобы оценить, что это за объект Worksheet:

With Worksheets(sheetName)
    ' Handle case where sheet is hidden
    If .Visible = False Then
        .Visible = True
        vFlag = True
....

    ' Hide sheet if it was unhidden above
    If vFlag = True Then
        .Visible = False
        vFlag = False
    End If
End with

Наконец, подумайте озапись значения в вашу ячейку вместо копирования-вставки, потому что копирование-вставка очень медленная.Подумайте об ограничении макроса тем диапазоном, который реально использует ваш лист.

'Supposing your data start at A1
Dim EndRow As Long
Dim EndColumn As Long
With Worksheets(sheetName)
    EndRow = .Range("A" & .Rows.Count).End(xlUp).Row
    EndColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

   .Range(.Cells(1, 1), .Cells(EndColumn, EndColumn)).Value2 = .Range(.Cells(1, 1), .Cells(EndColumn, EndColumn)).Value2
End With