Question

下面是我的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不会在每次单元格的值发生变化时进行计算。如果你有很多公式（似乎你这样做），计算可能会真正消耗性能。

您可能有理由这样做，但您也可能会尝试等待强制计算直到代码结束并立即计算整个工作簿。

无论何时将某些内容复制到剪贴板，都会降低性能。如果您只关心复制值，可以尝试复制值的Range("A1").Value = Range("B1").Value方法。这将绕过剪贴板并为您节省一些性能。

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

这是我能想到的唯一事情。祝你好运！

复制粘贴宏超慢需要优化

1 个答案: