哪个最快的方法来总结两个范围？

我需要从单个工作表中的多个工作簿和工作表中summ列值。 如果我想这样做：

While targetCell.Row <> LastRow targetCell.Value = targetCell.Value + sourseCell.Value Set sourseCell = sourseSheet.Cells(sourseCell.Row + 1, sourseCell.Column) Set targetCell = targetSheet.Cells(targetCell.Row + 1, targetCell.Column) Wend 

这需要太多的时间（几小时!!!）。

喜欢这个：

 targetSheet.Range("D14:BJ" & LastRow).Value = targetSheet.Range("D14:BJ" & LastRow).Value + sourseSheet.Range("D14:BJ" & LastRow).Value 

我有时有错误types不匹配

完整代码：

 For Each foldername In subFolders If foldername <> ThisWorkbook.path Then filePath = foldername & fileName Dim app As New Excel.Application app.Visible = False Dim book As Excel.Workbook Set book = app.Workbooks.Add(filePath) For Each targetSheet In ActiveWorkbook.Worksheets Dim sourseSheet As Worksheet Set sourseSheet = book.Worksheets(targetSheet.Name) Call CopyColumn(targetSheet, sourseSheet, LastRow) Next book.Close SaveChanges:=False app.Quit Set app = Nothing End If Next Sub CopyColumn(targetSheet, sourseSheet As Worksheet, LastRow As Integer) Dim sourseCell, targetCell As Range Set targetCell = targetSheet.Cells(14,"D") Set sourseCell = sourseCell.Cells(14,"CH") While targetCell.Row <> LastRow targetCell.Value = targetCell.Value + sourseCell.Value Set sourseCell = sourseSheet.Cells(sourseCell.Row + 1, sourseCell.Column) Set targetCell = targetSheet.Cells(targetCell.Row + 1, targetCell.Column) Wend End Sub 

Answer 1

将范围复制到Variant数组非常快。 你的子程序经过修改和评论如下：

 Sub CopyColumn(targetSheet As Worksheet, sourseSheet As Worksheet, LastRow As Long) ' LastRow as Integer will give an error for rows > 32,767, use Long instead ' Check the syntax: sourseCell, targetCell as Range means: ' sourceCell as Variant, targetCell as Range. We should include ' "as Range" after each variable declaration if we want it to be a Range Dim sourseCell As Range, targetCell As Range Dim lCount As Long Dim vTarget, vSource ' I kept the names targetCell, sourseSheet, but turned them to ranges ' You might want to change sourseSheet to sourceSheet With targetSheet Set targetCell = .Range(.Cells(14, "D"), .Cells(LastRow, "D")) End With ' I assume you mean sourceSheet instead of sourceCell, ' in your original code? With sourseSheet Set sourseCell = .Range(.Cells(14, "CH"), .Cells(LastRow, "CH")) End With vTarget = targetCell.Value2 vSource = sourseCell.Value2 ' If there is a change you do not have numeric values ' this needs error trapping For lCount = LBound(vTarget, 1) To UBound(vTarget, 1) vTarget(lCount, 1) = vTarget(lCount, 1) + vSource(lCount, 1) Next lCount targetCell.Value = vTarget End Sub 

testing：

 Option Explicit Private Declare Function GetTickCount Lib "kernel32.dll" () As Long Sub test_copy_column() Dim targetSheet As Worksheet, sourseSheet As Worksheet, LastRow As Long, _ tick As Long ' Maybe change sourseSheet to sourceSheet :) tick = GetTickCount ' Clock count Set targetSheet = Sheet1 Set sourseSheet = Sheet1 LastRow = 50000 ' I inputted random numbers for testing CopyColumn targetSheet, sourseSheet, LastRow MsgBox "Time to copy: " & GetTickCount - tick & " milliseconds" End Sub 

结果：

相关的SO问题在这里

我希望有帮助！

Answer 2

对于快速的非VBA解决scheme，请打开所有工作簿并将以下公式插入辅助工具表中：

 =first_cell_from_source_workbook + first_cell_from_target_workbook + ... 

复制公式以涵盖您需要覆盖的整个范围。

如果您希望replace目标范围中的原始值，请将值复制并粘贴到目标范围。

每次您希望重新计算时，确保所有源代码工作簿均已打开。