☰

VBA 复制和粘贴范围值太慢

tag-icon • tag-icon vba copy-paste
VBA 复制和粘贴范围值太慢

我正在使用这段代码，它运行良好，但运行速度非常慢。有人有其他方法吗？

Sub CopyPaste()

 Dim sourcerange As Workbook
 Dim currentrange As Workbook

 Dim r As Integer
 Dim c As Integer
 Dim z As Integer
 
 
 Set currentworkbook = ThisWorkbook.Sheets("Full Data Gantt")
 Set sourceworkbook = ThisWorkbook.Sheets("EVC Project Data")

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

r = 2
c = 16
z = 5

sourceworkbook.Range("C" & r & ":C" & c).Copy
currentworkbook.Range("B" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("A" & r & ":A" & c).Copy
currentworkbook.Range("C" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("E" & r & ":E" & c).Copy
currentworkbook.Range("D" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("G" & r & ":G" & c).Copy
currentworkbook.Range("E" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("F" & r & ":F" & c).Copy
currentworkbook.Range("F" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("J" & r & ":J" & c).Copy
currentworkbook.Range("G" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("L" & r & ":L" & c).Copy
currentworkbook.Range("H" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("P" & r & ":P" & c).Copy
currentworkbook.Range("I" & z).PasteSpecial xlPasteValues

r = r + 16
c = c + 16
z = z + 16

sourceworkbook.Range("C" & r & ":C" & c).Copy
currentworkbook.Range("B" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("A" & r & ":A" & c).Copy
currentworkbook.Range("C" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("E" & r & ":E" & c).Copy
currentworkbook.Range("D" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("G" & r & ":G" & c).Copy
currentworkbook.Range("E" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("F" & r & ":F" & c).Copy
currentworkbook.Range("F" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("J" & r & ":J" & c).Copy
currentworkbook.Range("G" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("L" & r & ":L" & c).Copy
currentworkbook.Range("H" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("P" & r & ":P" & c).Copy
currentworkbook.Range("I" & z).PasteSpecial xlPasteValues
r = r + 16
c = c + 16
z = z + 16

sourceworkbook.Range("C" & r & ":C" & c).Copy
currentworkbook.Range("B" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("A" & r & ":A" & c).Copy
currentworkbook.Range("C" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("E" & r & ":E" & c).Copy
currentworkbook.Range("D" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("G" & r & ":G" & c).Copy
currentworkbook.Range("E" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("F" & r & ":F" & c).Copy
currentworkbook.Range("F" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("J" & r & ":J" & c).Copy
currentworkbook.Range("G" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("L" & r & ":L" & c).Copy
currentworkbook.Range("H" & z).PasteSpecial xlPasteValues
sourceworkbook.Range("P" & r & ":P" & c).Copy
currentworkbook.Range("I" & z).PasteSpecial xlPasteValues

*****Repeat the same process for another 12 times****

Application.CutCopyMode = False

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  
End Sub

答案1

虽然很难看清您正在复制的范围，但如果您可以一次性复制整个范围而不是许多小范围，则可能会进行一些优化。

您绝对可以做的就是在每次修改后停止 Excel 计算整个工作表。

为此，请将以下代码放在宏的开头：

Application.Calculation = xlManual

并将以下代码放置在宏的末尾：

Application.Calculation = xlAutomatic

相关内容