为什么我的Excel VBA代码复制一个单元格这么慢？
我在同一个工作簿中有两个工作表。 如果SourceSheet中的某个单元格符合某些标准，我想将同一行中的几个不相邻的单元格复制到NewSheet中。 问题是粘贴每个单元需要花费半秒多的时间，这使得macros太慢了。 下面的代码需要8秒来完成一个单一的循环。 有没有更快的方式，我可以做到这一点？
Dim EnrollmentChanges As Range Dim course1 As Range Dim course1status As Range Dim row As Long Dim lrow As Long Dim NewSheetRow As Long 'This is a dynamic named range Set EnrollmentChanges = Sheets("SourceSheet").Range("Source") NewSheetRow = 0 lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row For row = 2 To lrow With EnrollmentChanges course1 = Sheets("SourceSheet").Range("A" & row) If course1 <> "" Then course1status = Sheets("SourceSheet").Range("BS" & row) If InStr(1, course1, "APEX") And course1status = "1" Then NewSheetRow = NewSheetRow + 1 Sheets("NewSheet").Range("A" & NewSheetRow) = NewSheetRow Sheets("NewSheet").Range("B" & NewSheetRow) = "W" Sheets("NewSheet").Range("C" & NewSheetRow) = "S" Sheets("NewSheet").Range("D" & NewSheetRow) = "MySchool" Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("G" & NewSheetRow) Sheets("SourceSheet").Range("W" & row).Copy Sheets("NewSheet").Range("H" & NewSheetRow) Sheets("SourceSheet").Range("V" & row).Copy Sheets("NewSheet").Range("J" & NewSheetRow) Sheets("SourceSheet").Range("Y" & row).Copy Sheets("NewSheet").Range("K" & NewSheetRow) Sheets("NewSheet").Range("L" & NewSheetRow) = "OR" Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("M" & NewSheetRow) Sheets("SourceSheet").Range("A" & row).Copy Sheets("NewSheet").Range("P" & NewSheetRow) End If Else: GoTo NextRow End If End With NextRow: Next 解决这个问题的最好办法是避免复制和粘贴（这是出了名的慢）。 唯一一次复制/粘贴可能值得保留的是当你需要复制格式。 如果你只是需要的价值，那么你可以做这样的事情：
Dim EnrollmentChanges As Range Dim course1 As Range Dim course1status As Range Dim row As Long Dim lrow As Long Dim NewSheetRow As Long 'This is a dynamic named range Set EnrollmentChanges = Sheets("SourceSheet").Range("Source") NewSheetRow = 0 lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row For row = 2 To lrow With EnrollmentChanges course1 = Sheets("SourceSheet").Range("A" & row) If course1 <> "" Then course1status = Sheets("SourceSheet").Range("BS" & row) If InStr(1, course1, "APEX") And course1status = "1" Then NewSheetRow = NewSheetRow + 1 With Sheets("NewSheet") .Range("A" & NewSheetRow).Value = NewSheetRow .Range("B" & NewSheetRow).Value = "W" .Range("C" & NewSheetRow).Value = "S" .Range("D" & NewSheetRow).Value = "MySchool" .Range("G" & NewSheetRow.Value = Sheets("SourceSheet").Range("B" & row).Value .Range("H" & NewSheetRow).Value = Sheets("SourceSheet").Range("W" & row).Value .Range("J" & NewSheetRow).Value = Sheets("SourceSheet").Range("V" & row).Value .Range("K" & NewSheetRow).Value = Sheets("SourceSheet").Range("Y" & row).Value .Range("L" & NewSheetRow).Value = "OR" .Range("M" & NewSheetRow).Value = Sheets("SourceSheet").Range("B" & row).Value .Range("P" & NewSheetRow).Value = Sheets("SourceSheet").Range("A" & row).Value End With End If ' No need for this since you are skipping the operation using the if block ' GoTo is messy and should be avoided where possible as well. 'Else: GoTo NextRow End If End With NextRow: Next
我所做的只是交换订单，并根据检索到的值直接分配值，并将检索到的值存储为副本，并将其置于新的位置。 一旦你练习了这一点，它会变得更有意义（这将大大加快你的代码）。
正如在开始时指出的那样，如果您需要格式化，那么这有点不同。
此外，我并不打扰优化或缩进您的代码的其他元素，但你会想要清理它适当的缩进和跳过像“GoTo”的东西。
call这个sub的macros：
Sub MakeItFaster() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False ActiveSheet.DisplayPageBreaks = False End Sub