VBA - 如何加快复制和粘贴的时间[重复]

Question

下面列出了完整的代码，我将数据透视表中的单元格 DB10 中的数据复制到清单表中的第 N 列 - 另请注意，清单表中的行是动态的，并且每周增长 3018 行。 ..这是减慢处理时间的部分（我对其进行了计时，运行代码时需要大约 8 分钟才能完成处理） 这部分是事情变慢的地方：

Sheets("PivotTables").Select
    Range("DB10").Select
    Selection.Copy
       Sheets("Checklists").Select
          Dim rng As Range
            NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(-3017).Row
              ARowCount = Cells(Rows.Count, 1).End(xlUp).Row
                For Each rng In Range("N" & NRowCount & ":N" & ARowCount)
                   rng.PasteSpecial xlPasteValues
                       Next rng

完整代码：

Sub WeeklyUpdate()
Application.ScreenUpdating = False
'
' WeeklyUpdate Macro
'

'


    Sheets("Checklists").Select
    Dim LR As Long

    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("A3:M" & LR).SpecialCells(xlCellTypeVisible).Select
'
    Selection.Copy
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Sheets("Checklists").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial 
    xlPasteValues
    Sheets("Checklists").AutoFilterMode = False
    Sheets("PivotTables").Select
    Range("DB10").Select
    Selection.Copy
    Sheets("Checklists").Select
    Dim rng As Range
    NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(-3017).Row
    ARowCount = Cells(Rows.Count, 1).End(xlUp).Row
    For Each rng In Range("N" & NRowCount & ":N" & ARowCount)
    rng.PasteSpecial xlPasteValues
    Next rng

    Sheets("Home").Select

    Application.ScreenUpdating = True

    End Sub

Answer 1

如果我理解正确，您只是将单元格DB10 中的值粘贴到N[NRowCount]:N[ARowCount] 范围内。

与其进行For 循环，不如尝试以下方式：

Range("N" & NRowCount & ":N" & ARowCount).Value = Range("DB10").Value

它消除了循环，应该是立即的。

您的最终代码大致如下所示：

...
Sheets("Checklists").AutoFilterMode = False
Sheets("Checklists").Range("N" & NRowCount & ":N" & ARowCount).Value = Sheets("PivotTables").Range("DB10").Value
Sheets("Home").Select