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

Question

下面列出了完整的代码，我正在将数据透视表中DB10单元格的数据复制到Checklist表中的第N列--还要注意Checklist表中的行是动态的，每周增长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