哪种最快的方法可以求和两个范围? [英] Which the fastest way to sum two range?

问题描述

我需要单个工作表中多个工作簿和工作表的汇总列值.如果我正在尝试这样做:

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!!!).

赞:

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

完整代码:

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

推荐答案

将范围复制到 Variant 数组非常快.您的子例程在下面进行了修改和评论:

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

测试:

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

结果:

此处的相关问题

希望对您有帮助！

这篇关于哪种最快的方法可以求和两个范围?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！