Which the fastest way to sum two range?

2019-07-23 15:34发布

I need summ column values from multiple workbooks and worksheets in single worksheet. If i'm trying do it like this:

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

It takes too much time(Hours!!!).

Like this:

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

I'm sometimes have error type mismatch

Full code:

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

2条回答
Deceive 欺骗
2楼-- · 2019-07-23 15:49

Copying the ranges to Variant arrays is quite fast. Your subroutine amended and commented below:

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

Result: enter image description here

Relevant SO question here

I hope that helps!

查看更多
萌系小妹纸
3楼-- · 2019-07-23 15:56

for fast non-VBA solution, open all workbooks and insert following formula into a helper sheet:

=first_cell_from_source_workbook + first_cell_from_target_workbook + ...

copy the formula to cover whole range you need to cover.

copy & paste-special-as-values to target range if you wish to replace the original values in target range..

each time you wish to recalculate, make sure all source workbooks are open.

查看更多
登录 后发表回答