Question

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

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

我有时会出现错误类型不匹配

完整代码：

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

测试：

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

结果： enter image description here

Relevant SO question here

我希望有所帮助！

Answer 2

对于快速非VBA解决方案，打开所有工作簿并将以下公式插入帮助表：

=first_cell_from_source_workbook + first_cell_from_target_workbook + ...

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

copy＆amp;如果要替换目标范围中的原始值，请将特殊值作为目标范围。

每次要重新计算时，请确保所有源工作簿都已打开。

哪两种范围最快的总和？

2 个答案: