Question

我一直在研究以下适用于Excel的VBA代码。它会更新＆＃34; DATA＆＃34;大约12,800条记录的表格，其中包含粘贴在表格中的新信息＆＃34; Update2＆＃34;，同时保留任何更新不可用的记录。这适用于大学部门，因此其预期用途是每年运行一次或两次作为记录更新。

目前这需要2分10秒才能运行，我很欣赏任何指导。我已经尝试了一些事情（你可以看到），但我已经达到了我的能力。感谢。

Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
        Application.StatusBar = "Please wait. Updating records."
    Sheets("Update2").Select
        'The lines below delete the the rows where regnum is zero and the header row.
        On Error Resume Next
        Rows("1:1").Select
            Selection.AutoFilter
                ActiveSheet.Range("$A$1:$G$12231").AutoFilter Field:=1, Criteria1:="0"
            Dim LastZero As Long
                LastZero = Range("A" & Rows.Count).End(xlUp).Row
                    Range("A2:G" & LastZero).Select
                    Selection.EntireRow.Delete
            ActiveSheet.Range("$A$1:$G$12152").AutoFilter Field:=1
        If Err Then
            'do nothing. This ignores a case where there are no rows where regnum is zero.
        End If
        Range("A1:G1").Select
            Selection.Delete Shift:=xlUp
        Dim LastRow As Long
            LastRow = Range("A" & Rows.Count).End(xlUp).Row
                Range("A1:G" & LastRow).Select
                Selection.Copy
            Sheets("DATA").Select
                Range("A2:G2").Select
                Selection.Insert Shift:=xlDown
        Columns("A:J").Select
            ActiveSheet.Range("A:J").RemoveDuplicates Columns:=1, Header:=xlYes
            'This removes duplicate regnums.
            'Unfortunately, this breaks all the formulae. Solutions welcome.
            'What follows is a trudging rewrite of each formula.
        Range("H2").Select
            ActiveCell = "=INDEX($M$2:$M$10, MATCH((LEFT($F2,1)),$L$2:$L$10,0))"
        Range("I2").Select
            ActiveCell = [redacted]
            'An INDEX-MATCH referring to another spreadsheet in the same folder.
            Range("J2").Select
            ActiveCell = "=INDEX(S:S, MATCH($C2,R:R,0))"
        Dim LastData As Long
            LastData = Range("A" & Rows.Count).End(xlUp).Row
                Range("H2:J2").Copy Range("H2:J" & LastData)
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
            Application.StatusBar = "Update complete."

Answer 1

一个简短的答案是在可以的时候停止使用Select和ActiveCell：

实施例

Range("A1:G1").Select
            Selection.Delete Shift:=xlUp
        Dim LastRow As Long
            LastRow = Range("A" & Rows.Count).End(xlUp).Row
                Range("A1:G" & LastRow).Select
                Selection.Copy

可以成为

Range("A1:G1").Delete Shift:=xlUp
        Dim LastRow As Long
            LastRow = Range("A" & Rows.Count).End(xlUp).Row
                Range("A1:G" & LastRow).Copy

如果将此应用于整个代码，它应该会快得多

有关如何避免复制粘贴的其他一些示例，例如，您可以检查Ozgrid： http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm

初学者VBA for Excel：如何加速我的代码？

1 个答案: