vba - 加快 VBA 速度吗？

Question

有没有办法加快这段代码的速度？我需要它来删除相同的内容并将其写入单元格，以强制其他 VBA 代码运行另一列上的代码。这就是它的作用，只是 super 慢。有时此表上有 2000 个条目/行。每个单元大约需要 3 秒，它几乎耗尽了我的 CPU 的资源，哈哈。 (i7 6850k @ 4.4ghz)。

原因是，有时数据会从电子表格的旧版本复制到新版本，并且 VBA 更新的列不会更新，除非我物理更改其检查的单元格。

Sub ForceUpdate()
    On Error GoTo Cleanup
    Application.ScreenUpdating = False ' etc..
    ThisWorkbook.Sheets("Sales Entry").Unprotect "password!"
    Dim cell As Range, r As Long
    r = 2
    For Each cell In ThisWorkbook.Sheets("Sales Entry").Range("E2:E10")
        If Len(cell) > 0 Then
            Dim old As String
            old = cell.Value
            ThisWorkbook.Sheets("Sales Entry").Range("E" & r).Value = ""
            ThisWorkbook.Sheets("Sales Entry").Range("E" & r).Value = old
            r = r + 1
        End If
    Next cell
Cleanup:
    Application.ScreenUpdating = True ' etc..
    ThisWorkbook.Sheets("Sales Entry").Protect "password!", _  
        AllowSorting:=True, AllowFiltering:=True
End Sub

其他 VBA 部分中的代码是

If StrComp("pp voice", Target.Value, vbTextCompare) = 0 Then
    Target.Value = "PP Voice"
    Target.Offset(0, 8).Value = "N\A"
    Target.Offset(0, 8).Locked = True
    Target.Offset(0, 10).Value = "N\A"
    Target.Offset(0, 10).Locked = True
End If

Target.Value 指的是第一段代码中的 E 列。目前我已将第一 block 连接到按钮上，但速度很慢。而且目标机器远没有我的强大。

Answer 1

使用 application.enableevents = false 和 application.calculation = xlcalculationmanual。退出前将其重新打开。如果每个单元格花费 3 秒，则您必须触发大型事件或复杂的计算周期。

改变，

Dim cell As Range, r As Long
r = 2
For Each cell In ThisWorkbook.Sheets("Sales Entry").Range("E2:E10")
    If Len(cell) > 0 Then
    Dim old As String
    old = cell.Value
    ThisWorkbook.Sheets("Sales Entry").Range("E" & r).Value = ""
    ThisWorkbook.Sheets("Sales Entry").Range("E" & r).Value = old
    r = r + 1
    End If
Next cell

...到，

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim cell As Range
With ThisWorkbook.Sheets("Sales Entry")
    For Each cell In .Range("E2:E10")
        If CBool(Len(cell.Value2)) Then
            cell = cell.Value2
        End If
    Next cell
End With

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True