excel - 加速通过工作簿按值覆盖工作表的宏

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 然后按值粘贴仅在手动完成时需要一点时间。

标签： excelvbaperformance

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