在VBA中添加单元格值的最有效方法?

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

使用一个循环,这比预期的要慢得多(目前15分钟以上)。手动完成这个过程并不需要很长时间。 也许我可以预先制作一些隐藏的工作表,填充一个附加公式,然后在VBA中,基本上模仿一个人如何手动做,但感觉屁股倒退。 在多个工作表中复制粘贴不应该更有效率。 同上链接摆弄。 读他们到一个数组也许? 但输出需要是常规工作表单元格,而不是数组…

pnuts的方法肯定是最好的!

一般来说,在单元上循环通常是性能方面最差的select。 它用1.2Munit testing了几个方法,结果如下:

 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