Question

我在VBA中做了一个程序来复制特定列中每个单元格中的公式，我有30501分，程序真的很慢，即使计算100分，还有更好的方法吗？

Sub Copyformulas()


Dim i As Integer
Dim cell As Range
Dim referenceRange As Range
Dim a As String

a = "$T$30510"
Set range1= ActiveSheet.Range("A1:A30510")
Set myrange = Range("T16:T30510")
i = 16

Do Until Cells(20, 30510)
    With range1
        For Each cell In myrange
            If cell.HasFormula Then
                Cells(i, 35).Value = cell.Address
                Cells(i, 36).Value = "'" & CStr(cell.Formula)
                i = i + 1
            End If
        Next
    End With
Loop
End Sub

Answer 1

您可以使用SpecialCells来优化您的范围。您不需要使用隐含的ActiveSheet。

设置rSource = Range（“A16：A30510”）。SpecialCells（xlCellTypeFormulas）

Sub Copyformulas()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim c As Range
    Dim rSource As Range

    Set rSource = ActiveSheet.Range("A16:A30510").SpecialCells(xlCellTypeFormulas)

    For Each c In rSource
        c.Offset(0, 34) = c.Address
        c.Offset(0, 35) = "'" & c.Formula
    Next

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Answer 2

尝试添加以下内容：

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

... Your Code ...

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

您可能只需要第一个，但它们都是使用中的好习惯。另外，你在哪里使用With ... End With声明？我在块中看不到任何使用它。

最好在模块顶部使用Option Explicit。并且未声明range1和myrange。

Application.Calculation

当访问工作表或范围的先例已更改时，Excel将自动重新计算工作表上的公式。由于循环超过30,000次，这会导致Excel每次循环重新计算，从而降低性能。

Application.ScreenUpdating

此行会停止Excel屏幕闪烁以及宏运行时发生的其他事情。

Application.EnableEvents

此行会关闭Worksheet_Change等事件，以便不会触发事件。如果未关闭，则只要工作表上发生更改，更改事件中的代码就会运行。如果您有Worksheet_SelectionChange事件，则每次选择不同的单元格时都会运行代码。这些事件写在VBE项目窗口中的工作表或工作簿对象中，有许多事件可供选择。这是一个非常简单的例子。将以下内容放在项目窗口中的Sheet1对象中：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MsgBox "Hi!"
End Sub

现在点击工作表。您会看到它响应每个选择更改。现在将以下内容放在常规模块中：

Sub TestEnableEvents()

Application.EnableEvents = False
ActiveCell.Offset(1, 0).Select
Application.EnableEvents = True

End Sub

运行上述代码时，不会触发消息框。

复制单元格公式VBA

2 个答案: