Question

我需要将两个范围的任意（但相同）大小的值相加。 input1中的A1与input2中的A1相加，然后输出到输出单元格中的A1，等等。我需要结束值，而不是公式或链接。

使用循环比预期慢得多（目前15分钟以上）。手动操作不需要很长时间。也许我可以预先制作一些隐藏的工作表填充一个额外的公式然后在VBA基本上模仿一个人如何手动做它但感觉屁股倒退。在多个工作表中执行复制粘贴不应该更多有效。同上链接摆弄。把它们读成阵列可能吗？但输出需要是常规工作表单元格，而不是数组......

Answer 1

pnuts'的做法当然是最好的！

通常，在单元上循环通常是性能方面最差的选择。它使用1.2M单元测试了几种方法，结果如下：

Looping each cell: 145,04s
Formula and store value: 6,89s
Formula and PasteSpecial Values: 3,44s
2x PasteSpecial Values&Add (pnuts approach): 0,72s

这是我使用的代码 - 使用方法M3执行任务：

Option Explicit

Private Sub TimeMethods()
    Dim strAddress As String
    Dim dblStart As Double
    Application.Calculation = xlCalculationManual
    strAddress = "A1:X50000"

    ClearRange strAddress, Sheet3
    dblStart = Timer
    M0 strAddress, Sheet1, Sheet2, Sheet3
    Debug.Print "Looping each cell: " & Timer - dblStart

    ClearRange strAddress, Sheet3
    dblStart = Timer
    M1 strAddress, Sheet1, Sheet2, Sheet3
    Debug.Print "Formula and store value: " & Timer - dblStart

    ClearRange strAddress, Sheet3
    dblStart = Timer
    M2 strAddress, Sheet1, Sheet2, Sheet3
    Debug.Print "Formula and PasteSpecial Values: " & Timer - dblStart

    ClearRange strAddress, Sheet3
    dblStart = Timer
    M3 strAddress, Sheet1, Sheet2, Sheet3
    Debug.Print "2x PasteSpecial Values&Add: " & Timer - dblStart

    Application.Calculation = xlCalculationAutomatic
End Sub

Sub M0(strAddress As String, wsInput1 As Worksheet, wsInput2 As Worksheet, wsOutput As Worksheet)
    Dim rngTemp As Range
    Dim intCol As Integer, lngRow As Long
    Set rngTemp = wsInput1.Range(strAddress)
    For lngRow = rngTemp.Row To rngTemp.Row + rngTemp.Rows.Count
        For intCol = rngTemp.Column To rngTemp.Column + rngTemp.Columns.Count
            wsOutput.Cells(lngRow, intCol) = _
                wsInput1.Cells(lngRow, intCol) + _
                wsInput2.Cells(lngRow, intCol)
        Next intCol
    Next lngRow
End Sub

Sub M1(strAddress As String, wsInput1 As Worksheet, wsInput2 As Worksheet, wsOutput As Worksheet)
    With wsOutput.Range(strAddress)
        .FormulaR1C1 = "='" & wsInput1.Name & "'!RC+'" & wsInput2.Name & "'!RC"
        .Value = .Value
    End With
End Sub

Sub M2(strAddress As String, wsInput1 As Worksheet, wsInput2 As Worksheet, wsOutput As Worksheet)
    With wsOutput.Range(strAddress)
        .FormulaR1C1 = "='" & wsInput1.Name & "'!RC+'" & wsInput2.Name & "'!RC"
        .Copy
        .PasteSpecial xlPasteValues
    End With
End Sub

Sub M3(strAddress As String, wsInput1 As Worksheet, wsInput2 As Worksheet, wsOutput As Worksheet)
    Dim rngOutput As Range, rngInput As Range
    Set rngOutput = wsOutput.Range(strAddress)
    wsInput1.Range(strAddress).Copy
    rngOutput.PasteSpecial xlPasteValues
    wsInput2.Range(strAddress).Copy
    rngOutput.PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
End Sub

Sub ClearRange(strAddress As String, wsOutput As Worksheet)
    wsOutput.Range(strAddress).Clear
End Sub

在VBA中在全等范围内添加单元格值的最有效方法？

1 个答案: