Question

我写了这个宏，但是它确实花了太长时间。我不知道如何使它运行得更快。

它的作用：检查工作表（Roh）中的每个单元格是否受保护（锁定），然后将跳过此单元格并转到下一个单元格；如果不受保护，它将复制并粘贴值另一个工作表（导入）。两张纸具有相同的格式。我用它来将当前项目更新到新版本。硬拷贝粘贴将无效，因为某些公式会更改。谁能帮我找到更快的方法吗？

谢谢！：）

mdy()

Answer 1

您可以尝试使用数组来提高例程速度。只需使用您的inRng范围更新Import

Option Explicit
Sub import()
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim inRng As Range
    Dim inArr As Variant, lockArr As Variant
    Dim i As Long, j As Long

    Dim StartTime As Double
    Dim MinutesElapsed As String

    StartTime = Timer

    With ThisWorkbook
        Set srcSht = .Sheets("Import")
        Set destSht = .Sheets("Roh")
    End With

    With srcSht
        Set inRng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(.Cells(1, .Columns.Count).End(xlToLeft).Column)))
    End With

    inArr = inRng.Value2
    ReDim outArr(LBound(inArr, 1) To UBound(inArr, 1), LBound(inArr, 2) To UBound(inArr, 2))

    For i = 1 To inRng.Rows.Count
        For j = 1 To inRng.Columns.Count
            If Not inRng.Cells(i, j).Locked Then
                outArr(i, j) = inArr(i, j)
            End If
        Next j
    Next i

    With destSht
        .Cells(1, 1).Resize(UBound(outArr, 2), UBound(outArr, 1)).Value2 = outArr
    End With

    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    MsgBox "Dieser Code wurde in " & MinutesElapsed & " Minuten erfolgreich ausgeführt.", vbInformation

End Sub

Answer 2

为提高速度，您可以在文件的开头和结尾添加以下两项：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
xxxxxxxxxxx
{ Code }
xxxxxxxxxxx
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

ScreenUpdating禁用实时可视化操作（当您将粘贴复制粘贴到另一张纸上时，例如避免屏幕闪烁）。

计算避免每次操作都重新计算数据。

仅复制和粘贴花费时间过长的未受保护的单元格

2 个答案: