读/写大量的数据

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

我的目标是将表格4中的范围V13：XI1150中的数据复制到表格5-160中。 我尝试分解代码存储的范围（参见variablesrng1和rng2），以及将10个工作表组合在一起（尽pipe我认识到这一点效果不大）。

有没有办法简化我在这里工作的代码，所以我可以成功地复制这些数据？

提前致谢。

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 

Answer 1

我用下面的代码运行了一个快速testing，运行得很好：

 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 

我的testing单元中只有静态数据，而不是公式。 这可能会有所不同，因为当您重新打开“自动计算”时，这对您的系统资源来说将是一个巨大的打击，尤其是对于您的单元格中的复杂计算。

Answer 2

这可能是额外的复制，你正在做你的循环即

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

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

尽pipe如此，如果您的范围原点中没有公式，这是一个备用解决scheme。 由于您的目的地始终是相同的，并且您的原点范围是相同的维度（只是不同的起点），您可以避免复制/粘贴在一起：

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

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

* – EDIT– *

如果你确实需要公式，你可以改变.Value to .Formula ，但是请注意，这将“粘贴”引用原始表单的公式，而不是目标工作表的相对引用。 在运行macros之前，我也会closures自动计算（ Application.Calculation = xlCalculationManual ，并且最后计算或打开计算（ Application.Calculation =xlCalculationAutomatic ），或者在每个“ Application.Calculation =xlCalculationAutomatic ”之后使用Application.Calculate 。