復制單元格公式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

當您運行上述代碼時，將不會觸發該消息框。