复制粘贴macros是超慢| 需要优化

下面是我的VBA代码是超慢（需要大约3分钟复制和粘贴三个新行！）。 数据库本身包含大约10,000行，我不确定是否会导致性能下降，或者代码本身是否有效。 这当然与硬件钻机无关。

Sub AutomateUserResearch() Dim rowlast As Long 'letzte benutze Zeile Dim rowlastexport As Long 'letzte benutze Zeile auf "database" + 1 addieren Dim rowlastexportfinal As Long 'letzte benutze Zeile auf "database" nach Hinzufügen neuer Zeilen finden Dim NewRecords As String Dim i As Integer Application.ScreenUpdating = False Calculate NewRecords = ThisWorkbook.Worksheets("checklist").Range("NewRecordsCheck").Value With Sheets("csv_import") rowlast = .UsedRange.Rows.Count + .UsedRange.Row - 1 'find last used row on "csv_import" .Range(.Cells(2, 1), .Cells(rowlast, 1)).Formula = .Cells(2, 1).Formula 'copy down formulas for column A ' .Range(.Cells(2, 1), .Cells(rowlast, 1)).Select ' With Selection ' .Interior.ThemeColor = xlThemeColorAccent4 ' End With .Range(.Cells(2, 2), .Cells(rowlast, 2)).Formula = .Cells(2, 2).Formula 'copy down formulas for column B End With Sheets("csv_import").Calculate With Sheets("csv_import") rowlast = .UsedRange.Rows.Count + .UsedRange.Row - 1 End With With Sheets("database") rowlastexport = .UsedRange.Rows.Count + 1 + .UsedRange.Row - 1 End With ActiveWorkbook.Worksheets("csv_import").Activate If NewRecords = "YES" Then 'only proceed with Sub if Column A on "csv_import" has rows with "new" in it, otherwise Exit Sub as no new records exist 'MsgBox ("New Records Exist") ActiveSheet.Range("A1:S1").AutoFilter Field:=1, Criteria1:="new" ActiveSheet.Range("B2 : D" & rowlast).Copy Sheets("database").Range("A" & rowlastexport).PasteSpecial Sheets("csv_import").Range("A1:S1").AutoFilter Field:=1 Sheets("csv_import").Calculate Sheets("checklist").Calculate Else: MsgBox ("There are no new records to be exported!") Exit Sub End If With ActiveWorkbook.Worksheets("database") rowlastexportfinal = .UsedRange.Rows.Count + 1 + .UsedRange.Row - 1 For i = 4 To 19 'iterate through column 4 to 19 to copy down formulas and add color .Range(.Cells(2, i), .Cells(rowlastexportfinal, i)).Formula = .Cells(2, i).Formula .Range(.Cells(2, i), .Cells(rowlastexportfinal, i)).Interior.ColorIndex = 15 Next i End With Sheets("database").Calculate Sheets("database").Select Application.ScreenUpdating = True End Sub 

Answer 1

我没有看到明显的东西。 一些想法：

你可以尝试设置Application.Calculation = xlCalculationManual 。 每当单元格的值发生变化时，Excel将不会计算。 如果你有很多公式（看起来你是这样做的），计算可能是一个真正的性能stream失。

这样做的方式可能有一个原因，但是您也可以尝试等待，直到代码结束，然后一次计算整个工作簿。

任何时候你复制一些东西到剪贴板，它会消耗性能。 如果您只关心复制值，您可以尝试Range("A1").Value = Range("B1").Value复制值的Range("A1").Value = Range("B1").Value方法。 这将绕过剪贴板，并为您节省一些性能。

如果您有任何工作表事件，可以尝试设置Application.EnableEvents = False 。

这些是我能想到的唯一的东西。 祝你好运！