复制单元格公式VBA

时间:2016-06-28 10:51:22

标签: excel vba excel-vba

我在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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

尝试添加以下内容:

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。并且未声明range1myrange

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

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