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

如果我理解正确，您只需将单元格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

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

您的最终代码大致如下：

{{1}}

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

1 个答案: