复制单元格公式VBA

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

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