gpt4 book ai didi

vba - 读取/写入大量数据

转载 作者:行者123 更新时间:2023-12-04 20:45:23 32 4
gpt4 key购买 nike

我正在将大量数据从一个电子表格复制到工作簿中的其他 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

最佳答案

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

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

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

关于vba - 读取/写入大量数据,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/19323656/

32 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com