Copy/PastEspecial vs range.value=

Question

我在这个站点（和其他地方）读过很多次，如果可能的话，最好避免在VBA宏中复制/粘贴。例如，与其这样做...

For i = 1 To tbl.ListColumns.Count
    With tbl.ListColumns(i).DataBodyRange
        .FormulaR1C1 = "=2*1"
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
Next

...这样做应该更好/更快：

For i = 1 To tbl.ListColumns.Count
    With tbl.ListColumns(i)
        .DataBodyRange.FormulaR1C1 = "=2*1"
        .DataBodyRange = .DataBodyRange.Value
    End With
Next

但是在一个大表（15列，100K行）上测试，复制/粘贴版本要快得多（1.9秒比2.7秒）。即使我先将tbl.DataBodyRange声明为范围变量，差异仍然存在。

我认为这可能是ListObjects的一些奇怪属性，但实际上没有它们的区别更大：

'Runs in 1.1 seconds
With Sheet1.Range("A1:O100000")
    .FormulaR1C1 = "=2*1"
    .Copy
    .PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End With

'Runs in 2.1 seconds
With Sheet1.Range("A1:O100000")
    .FormulaR1C1 = "=2*1"
    .Value = .Value
End With

有人知道为什么复制/粘贴方法要快得多吗？还有其他原因避免使用复制/粘贴（假设宏运行时剪贴板永远不会在Excel之外使用）吗？

编辑：以下是第一组测试结果，将copy/pastevalues与mat的杯子在接受的答案中描述的数组读/写方法进行比较。我测试了从1000个单元格到100万个单元格的范围大小，每次增加1000个，并对每个范围大小进行了平均10次测试。复制粘贴开始较慢，但很快超过了设置值方法（图表上很难看到，但盈亏平衡点是~15K单元格）。

我还在范围的低端运行了10个进一步的测试（范围大小从100个单元格到100000个单元格，每次递增100个单元格），试图确定盈亏平衡点发生在哪里。这一次我使用了查尔斯·威廉姆斯的“微计时器”而不是默认的计时器，希望它在亚秒计时时更准确。我还包括了“set array”版本和原始的“.value=.value”版本（并记得将计算切换到手动，与第一组测试不同）。有趣的是，数组读/写方法这次的表现明显更差，盈亏平衡点约为3300个单元格，峰值性能更差。数组读/写和。value=.value之间几乎没有区别，尽管数组版本的性能稍差一些。

下面是我在上一轮测试中使用的代码：

Sub speedTest()
    Dim copyPasteRNG(1 To 10, 1 To 1000)
    Dim setValueRNG(1 To 10, 1 To 1000)
    Dim setValueArrRNG(1 To 10, 1 To 1000)

    Dim i As Long
    Dim j As Long
    Dim numRows As Long
    Dim rng As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False

    For i = 1 To 10
        numRows = 100
        For j = 1 To 1000
            Set rng = Sheet3.Range("A1:A" & numRows)
            setValueRNG(i, j) = getTime(False, rng, False)
            setValueArrRNG(i, j) = getTime(False, rng, True)
            numRows = numRows + 100
        Next
    Next

    For i = 1 To 10
        numRows = 100
        For j = 1 To 1000
            Set rng = Sheet3.Range("A1:A" & numRows)
            copyPasteRNG(i, j) = getTime(True, rng)
            numRows = numRows + 100
        Next
    Next

    Sheet4.Range("A1:J1000").Value2 = Application.Transpose(copyPasteRNG)
    Sheet5.Range("A1:J1000").Value2 = Application.Transpose(setValueRNG)

    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Function getTime(copyPaste As Boolean, rng As Range, Optional arrB As Boolean) As Double
    Dim startTime As Double
    Dim endTime As Double

    startTime = MicroTimer

    With rng
        .FormulaR1C1 = "=1"
        If copyPaste = True Then
            .Copy
            .PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
        ElseIf arrB = True Then
            Dim arr As Variant
            arr = .Value2
            .Value2 = arr
        Else
            .Value2 = .Value2
        End If
    End With

    endTime = MicroTimer - startTime

    getTime = endTime

End Function

下面是我使用的微计时器版本（在单独的模块中）：

Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Function MicroTimer() As Double

    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
     '
    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency
    getTickCount cyTicks1
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency

End Function

Answer 1

大多数（至少很多）VBA宏不能“使用集合”，不能迭代一个范围内的单元格。不是因为这是个好主意（不是），而是因为很多人根本不知道更好。

在处理对象集合（如范围）时，最快的循环是每个循环的。所以我接受了您的测试，对它进行了一点重构，添加了迭代解决方案的测试，然后添加了数组读/写测试，因为这也是复制单元格值的一种常见的好方法。

请注意，我从各个测试中提取了编写公式的设置步骤。

注意：此代码采用控制流最佳实践，并将它们隐藏在地毯之下。不要在实际代码中使用gosub/return。

Sub Test()

    Const TEST_ROWCOUNT As Long = 10

    Const RANGE_ADDRESS As String = "A1:O" & TEST_ROWCOUNT
    Const RANGE_FORMULA As String = "=2*1"

    Dim startTime As Double

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Debug.Print "Testing with " & Sheet1.Range(RANGE_ADDRESS).Count & " cells (" & TEST_ROWCOUNT & " rows)"

    GoSub InitTimer
    TestPasteFromClipboard Sheet1.Range(RANGE_ADDRESS)
    Debug.Print "Pasting from clipboard, single operation:",
    GoSub ReportTime

    GoSub InitTimer
    TestSetRangeValue Sheet1.Range(RANGE_ADDRESS)
    Debug.Print "Setting cell values, single operation:",
    GoSub ReportTime

    GoSub InitTimer
    TestIteratePaste Sheet1.Range(RANGE_ADDRESS)
    Debug.Print "Pasting from clipboard, iterative:",
    GoSub ReportTime

    GoSub InitTimer
    TestIterateSetValue Sheet1.Range(RANGE_ADDRESS)
    Debug.Print "Setting cell values, iterative:",
    GoSub ReportTime

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Exit Sub

InitTimer:
    Sheet1.Range(RANGE_ADDRESS).Formula = RANGE_FORMULA
    startTime = Timer
    Return
ReportTime:
    Debug.Print (Timer - startTime) * 1000 & "ms"
    Return
End Sub

Private Sub TestPasteFromClipboard(ByVal withRange As Range)
    With withRange
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
End Sub

Private Sub TestSetRangeValue(ByVal withRange As Range)
    withRange.Value = withRange.Value
End Sub

Private Sub TestIteratePaste(ByVal withRange As Range)
    Dim cell As Range
    For Each cell In withRange.Cells
        cell.Copy
        cell.PasteSpecial Paste:=xlPasteValues
    Next
    Application.CutCopyMode = False
End Sub

Private Sub TestIterateSetValue(ByVal withRange As Range)
    Dim cell As Range
    For Each cell In withRange.Cells
        cell.Value = cell.Value
    Next
    Application.CutCopyMode = False
End Sub

我不得不将范围大小缩小一个数量级（否则我仍然会盯着没有响应的Excel屏幕），但这是输出--当然，逐单元格迭代方法要慢得多，但请注意剪贴板数字与直接的值赋值相比是如何的：

Testing with 150 cells (10 rows)
Pasting from clipboard, single operation: 11.71875ms
Setting cell values, single operation:    3.90625ms
Pasting from clipboard, iterative:        1773.4375ms
Setting cell values, iterative:           105.46875ms

Testing with 150 cells (10 rows)
Pasting from clipboard, single operation: 11.71875ms
Setting cell values, single operation:    3.90625ms
Pasting from clipboard, iterative:        1718.75ms
Setting cell values, iterative:           109.375ms

Testing with 150 cells (10 rows)
Pasting from clipboard, single operation: 15.625ms
Setting cell values, single operation:    3.90625ms
Pasting from clipboard, iterative:        1691.40625ms
Setting cell values, iterative:           136.71875ms

因此，对于10行/150个单元格，将范围复制到数组中/赋值range.value比剪贴板解决方案要快得多。

显然，迭代方法要慢得多，但请注意，与直接分配范围值相比，剪贴板解决方案要慢得多！

是时候进行另一次测试运行了。

Testing with 1500 cells (100 rows)
Pasting from clipboard, single operation: 11.71875ms
Setting cell values, single operation:    7.8125ms
Pasting from clipboard, iterative:        10480.46875ms
Setting cell values, iterative:           1125ms

Testing with 1500 cells (100 rows)
Pasting from clipboard, single operation: 19.53125ms
Setting cell values, single operation:    3.90625ms
Pasting from clipboard, iterative:        10859.375ms
Setting cell values, iterative:           2390.625ms

Testing with 1500 cells (100 rows)
Pasting from clipboard, single operation: 15.625ms
Setting cell values, single operation:    3.90625ms
Pasting from clipboard, iterative:        10964.84375ms
Setting cell values, iterative:           1062.5ms

现在就不那么明确了，但是抛出数组似乎仍然是更可靠、更快的解决方案。

Testing with 15000 cells (1000 rows)
Pasting from clipboard, single operation: 15.625ms
Setting cell values, single operation:    15.625ms
Pasting from clipboard, iterative:        80324.21875ms
Setting cell values, iterative:           11859.375ms

Testing with 15000 cells (1000 rows)
Pasting from clipboard, single operation: 19.53125ms
Setting cell values, single operation:    15.625ms

Testing with 15000 cells (1000 rows)
Pasting from clipboard, single operation: 23.4375ms
Setting cell values, single operation:    15.625ms

相当一致；同样，剪贴板丢失。但是10K行怎么样？

Testing with 150000 cells (10000 rows)
Pasting from clipboard, single operation: 46.875ms
Setting cell values, single operation:    144.53125ms

Testing with 150000 cells (10000 rows)
Pasting from clipboard, single operation: 46.875ms
Setting cell values, single operation:    148.4375ms

Testing with 150000 cells (10000 rows)
Pasting from clipboard, single operation: 50.78125ms
Setting cell values, single operation:    144.53125ms

我们在这里-剪贴板现在显然赢了！

底线：如果你有100K的单元格，剪贴板可能是个好主意。如果有10k个单元格（或更少），则 value赋值 数组转储可能是更快的方法。任何介于两者之间的事情都可能需要基准测试和测试来找出更快的方法。

为了完成：

Testing with 1500000 cells (100000 rows)
Pasting from clipboard, single operation: 324.21875ms
Setting cell values, single operation:    1496.09375ms

Testing with 1500000 cells (100000 rows)
Pasting from clipboard, single operation: 324.21875ms
Setting cell values, single operation:    1445.3125ms

Testing with 1500000 cells (100000 rows)
Pasting from clipboard, single operation: 367.1875ms
Setting cell values, single operation:    1562.5ms

对于 巨大的 YUGE范围，直接设置单元格值似乎一直优于数组转储，但剪贴板的性能优于两者，而且相当大的优势。

所以：

null