最有效的方法是在VBA中的全等范围内添加单元格值？ [英] Most efficient way to add cell values across congruent ranges in VBA?

问题描述

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

使用循环这比预期慢很多（目前为15分钟以上）。手动执行不需要太长时间。也许我可以预先制作一些隐藏的工作表，填写一个附加公式，然后在VBA中基本上模仿人类如何手动做，但感觉到沮丧。跨多个工作表复制粘贴不应更有效率。同上线连接起来。读他们的阵列呢？但是输出需要是常规的工作表单元格，而不是数组...

解决方案

pnuts的方法当然是最好的！ / p>

通常，循环单元通常是性能方面最差的选项。它测试了一些1.2M单元格的方法，结果如下：

 循环每个单元格：145,04s 
公式和存储值：6,89s 
公式和Paste特殊值：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循环每个单元格& Timer  -  dblStart 
 
 ClearRange strAddress，Sheet3 
 dblStart = Timer 
 M1 strAddress，Sheet1，Sheet2，Sheet3 
 Debug.Print公式和存储值：& Timer  -  dblStart 
 
 ClearRange strAddress，Sheet3 
 dblStart = Timer 
 M2 strAddress，Sheet1，Sheet2，Sheet3 
 Debug.PrintFormula and PasteSpecial Values：& Timer  -  dblStart 
 
 ClearRange strAddress，Sheet3 
 dblStart = Timer 
 M3 strAddress，Sheet1，Sheet2，Sheet3 
 Debug.Print2x 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 
设置rngTemp = wsInput1.Range（strAddress）
对于lngRow = rngTemp.Row到rngTemp.Row + rngTemp.Rows .Count 
对于intCol = rngTemp.Column到rngTemp.Column + rngTemp.Columns.Count 
 wsOutput.Cells（lngRow，intCol）= _ 
 wsInput1.Cells（lngRow，intCol）+ _ 
 wsInput2.Cells（lngRow，intCol）
下一个intCol 
下一个lngRow 
 End Sub 
 
 Sub M1（strAddress As String，wsInput1 As Worksheet，wsInput2作为工作表，wsOutput作为工作表）
与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作为工作表）
带有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作为工作表，wsOutput作为工作表）
 Dim rngOutput As Range，rngInput As Range 
设置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 
  

I need to sum the values two ranges of arbitrary (but identical) sizes. A1 in input1 gets summed with A1 in input2, then output to A1 in the output cell, etc. I need the end values, not formulas or links.

Using a loop this is much, much slower than expected (currently 15+ minutes.) It does not take that long to do it manually. Maybe I could pre-make some hidden worksheets filled an addition formula and then in VBA essentially mimic how a human would manually do it but it feels ass-backwards. Doing copy pastes across multiple worksheets should not be more efficient. Ditto link fiddling. Read them into an array maybe? But the output needs to be regular worksheet cells, not an array...

解决方案

pnuts' approach is certainly the best!

Generally, looping over the cells is usually the worst option in terms of performance. It tested a few methods with 1.2M cells, here's the result:

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

Here's the code I used - use method M3 for your task:

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中的全等范围内添加单元格值？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！