读取/写入大量数据答案

【问题标题】：Read/Write Large Amounts of Data读取/写入大量数据
【发布时间】：2013-10-19 20:37:33
【问题描述】：

我正在将大量数据从一个电子表格复制到工作簿中的其他 160 个电子表格。目前，Excel (2013) 遇到错误，因为它没有足够的资源来完成操作。

我的目标是将工作表 4 中 V13:XI1150 范围内的数据复制到工作表 5-160。我尝试拆分存储代码的范围（请参阅变量 rng1 和 rng2），以及将 10 个工作表组合在一起（尽管我意识到这没什么效果）。

有没有办法简化我正在处理的代码，以便我可以成功复制这些数据？

提前致谢。

Sub copypaste()

'''''''''Globals'''''''''''''

Dim j As Long 'Loop control variable
Dim sheetstart As Integer 'starting sheet variable
Dim sheetend As Integer 'ending sheet variable
Dim rng1 As Range 'range to copy
Dim rng2 As Range 'Second range

Application.Calculation = xlCalculationManual 'Sets manual calculation
Application.ScreenUpdating = False 'Turns off screen updating


sheetstart = 5 'first sheet to copy over in loop
sheetend = 15 'last sheeet to copy over in loop

With Sheets(4) 'Selects the 4th sheet
    Set rng1 = Range("V13:LO1150") 'Stores first half of data in rng
    Set rng2 = Range("LP13:XI1150") 'Stores second half of data in rng
End With


For j = 1 To 16 'loops through all groups of 10 sheets
    copypaste10 rng1, sheetstart, sheetend 'calls copypaste10 function
    copypaste10 rng2, sheetstart, sheetend 'calls copypaste10 function
    sheetstart = sheetstart + 10 'increments to next 10 sheets
    sheetend = sheetend + 10 'increments to next 10 sheets

    Next

Application.Calculation = xlCalculationAutomatic 'Sets auto calculation
Application.ScreenUpdating = True 'Turns on screen updating


End Sub


Public Function copypaste10(rng As Range, sstart As Integer, sstop As Integer)
'''''''''Locals'''''''''''''
    Dim i As Long 'Loop control
    Dim WS As Worksheet 'worksheet being worked on
    Dim ArrayOne() As String 'Array of sheets we are working on

    ReDim ArrayOne(sstart To sstop) 'Array of sheets

''''''''''Calcuations'''''''''''''
    For i = sstart To sstop
        ArrayOne(i) = Sheets(i).Name
    Next

    For Each WS In Sheets(ArrayOne)
        WS.Rows(2).Resize(rng.Count).Copy
        rng.Copy Destination:=WS.Range("v13")
        Next WS


End Function

【问题讨论】：

是否有足够的资源将数据复制到单个目标工作表而不是所有 155 个工作表？
足够复制到一张纸上。
几乎可以肯定问题出在计算上，而不是复制/粘贴。在将数据复制到其中之后，您很可能需要将每个工作表保存在单独的工作簿中，然后关闭该工作簿，然后再转到下一个工作表。这应该可以防止重新计算导致您的系统崩溃。

标签： vba excel large-data

【解决方案1】：

我使用以下代码进行了快速测试，结果运行良好：

Sub test()

    Application.ScreenUpdating = False

    Dim rng As Range
    Set rng = Worksheets("Sheet1").Range("V13:XI1150")
    rng.Copy

    For i = 2 To 161
        Sheets(i).Select
        Range("V13").Select
        ActiveSheet.Paste
    Next

    Application.ScreenUpdating = True

End Sub

我的测试单元格中只有静态数据，没有公式。这可能会有所不同，因为当您重新打开自动计算时，这将对您的系统资源造成巨大影响，尤其是在您的单元格中进行复杂计算时。

【讨论】：

我所有的数据都是公式，我会尝试关闭自动计算和/或分块打开它。

【解决方案2】：

这可能是您在循环中所做的额外复制，即

WS.Rows(2).Resize(rng.Count).Copy

即使您似乎没有将其粘贴到任何地方，该副本也会存储到内存中（老实说，我不确定剪贴板是否会在退出功能后或根据需要清除）

不过，如果您的范围来源中没有公式，这是一种替代解决方案。由于您的目的地始终相同，并且您的起点范围是相同的维度（只是起点不同），因此您可以避免复制/粘贴在一起：

For Each WS In Sheets(ArrayOne)
    WS.Range("V13:LO1150") = rng.Value
Next WS

再次注意，它只会将值复制到您的目标工作表中

*--编辑--*

如果您确实需要公式，可以将 .Value 更改为 .Formula，但请注意，这将“粘贴”引用原始工作表的公式，而不是目标工作表的相对引用。我还会在运行宏之前关闭自动计算（Application.Calculation = xlCalculationManual，然后在最后计算或打开计算（Application.Calculation =xlCalculationAutomatic），或者在每隔几次“粘贴”之后使用Application.Calculate。

【讨论】：