VBA Copy(复制)方法比Cut(剪切)方法效率快10倍以上

ivccav

在我写的一个小代码过程中发现， Copy(复制)方法比Cut(剪切)方法效率快10倍以上。我要在订单中移除已经完成的订单到另一个工作表，开始是使用Cut方法，用了417秒。我觉得太慢，改用Copy方法，只用了31秒。
过程是：先复制已完成订单到目的工作表，然后把数据清除内容：ClearContents，全部移除之后做一个排序，并把空出来的那些行，再一次性清除内容、批注和格式：Clear.（没办法，ClearContents效率也远比Clear高）。

上传了附件，大家可以试试把代码中的Copy改为Cut。因为数据很大，我加了进度条和百分百显示，会多花一点时间了。

复件 全部订单.zip (464.51 KB, 下载次数: 229)

2017-7-25 08:25 上传

点击文件名下载附件
附件

ivccav

还有，在复制语句后面加一句：Application.CutCopyMode = False貌似也稍微快几秒钟。

jiangxiaoyun

这些不用测试，基本都知道。感谢你分享。

ivccav

'把红色的Copy改为Cut，效率会慢10倍

Sub Finished()
t = Timer
Application.EnableEvents = False
UserForm1.Show 0  '有进度条，因此请下载附件后使用
DoEvents
With Sheet1
r = .Range("a" & Rows.Count).End(3).Row
If r < 3 Then Exit Sub
Set rng = .Range("s3:s" & r)
i = 0
For Each c In rng
    If c = "Y" Or c = "y" Or c = "OK" Then
        L = Sheet2.Range("a" & Rows.Count).End(3).Row
        If L > Rows.Count - 2 Then Call NewSheet: L = Sheet2.Range("a" & Rows.Count).End(3).Row
        c.EntireRow.Copy Sheet2.Range("a" & L + 1)
        Application.CutCopyMode = False
        c.EntireRow.ClearContents
        i = i + 1
    End If
UserForm1.Label1.Caption = "程序正在进行：" & Format(c.Row / (2 * r), "0.00%")
DoEvents
Next
Set rng = .Range("n3:n" & r)
For Each c In rng
    If (c.Offset(, 1) <> "" And c.Offset(, 1) < Date) Or (c.Offset(, 1) = "" And c <> "" And c < Date) Then
        L = Sheet2.Range("a" & Rows.Count).End(3).Row
        If L > Rows.Count - 2 Then Call NewSheet: L = Sheet2.Range("a" & Rows.Count).End(3).Row
        c.EntireRow.Copy Sheet2.Range("a" & L + 1)
        Application.CutCopyMode = False
        c.EntireRow.ClearContents
        i = i + 1
    End If
UserForm1.Label1.Caption = "程序正在进行：" & Format((c.Row + r) / (2 * r), "0.00%")
DoEvents
Next
.Range("3:" & r).Sort key1:=.Range("a3"), Order1:=xlAscending, header:=xlNo
r = .Range("a" & Rows.Count).End(3).Row
.Range(r & ":" & Rows.Count).Clear
.Range("a" & Rows.Count).End(3).Offset(1).Select
End With
Unload UserForm1
MsgBox "共移除 " & i & "项 已完成订单！用时" & Format(Timer - t, "0.00\秒") & vbCrLf & "按『确定』键结束"
Application.EnableEvents = True
Set rng = Nothing
End Sub
Sub NewSheet() '当备份工作表填满时，开启新工作表
    Sheet2.Copy after:=Sheet2
    ActiveSheet.Name = "备份_" & Format(Date, "yyyy-mm-dd")
    Sheet2.Range("3:" & Rows.Count).Clear
End Sub

ivccav

jiangxiaoyun 发表于 2017-7-25 08:50
这些不用测试，基本都知道。感谢你分享。

不会吧？我没有学过VBA，没有系统的了解过，只是在需要的时候，自己慢慢写几句。不好意思，贻笑大方了！

fewly

谢谢分享经验