Excel VBA需要很长时间才能将date从一个工作簿复制到另一个工作簿
我正在尝试使用VBA将数据从一个Excel复制到另一个。 但是30K线需要15分钟以上。 有没有办法让我的速度更快？
我需要将New Report工作簿中的39列与ACQ047 WBalignment。
以下是我的代码：
Sub alignment() Dim x As Workbook Dim y As Workbook Set x = Workbooks.Open("C:\Users\raja\Desktop\New Report.xls") Set y = Workbooks.Open("C:\Users\raja\Desktop\ACQ047.xlsx") Dim Lastrow As Long y.Sheets("unmached").Range("A2").Activate y.Sheets("unmached").Rows(ActiveCell.Row & ":" & Rows.Count).Delete Shift:=xlUp x.Sheets("New Report").Rows(1).EntireRow.Delete x.Sheets("New Report").Range("A1").EntireRow.Insert Lastrow = x.Sheets("New Report").Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False '!!!! Application.Calculation = xlCalculationManual '!!!! For i = 1 To Lastrow CopyVal = x.Sheets("New Report").Range("A1").Offset(i, 2).Value CopyVal2 = x.Sheets("New Report").Range("A1").Offset(i, 6).Value CopyVal3 = x.Sheets("New Report").Range("A1").Offset(i, 8).Value CopyVal4 = x.Sheets("New Report").Range("A1").Offset(i, 11).Value CopyVal5 = x.Sheets("New Report").Range("A1").Offset(i, 12).Value CopyVal6 = x.Sheets("New Report").Range("A1").Offset(i, 14).Value CopyVal7 = x.Sheets("New Report").Range("A1").Offset(i, 16).Value CopyVal8 = x.Sheets("New Report").Range("A1").Offset(i, 18).Value CopyVal9 = x.Sheets("New Report").Range("A1").Offset(i, 19).Value CopyVal10 = x.Sheets("New Report").Range("A1").Offset(i, 20).Value CopyVal11 = x.Sheets("New Report").Range("A1").Offset(i, 21).Value CopyVal12 = x.Sheets("New Report").Range("A1").Offset(i, 22).Value CopyVal13 = x.Sheets("New Report").Range("A1").Offset(i, 23).Value CopyVal14 = x.Sheets("New Report").Range("A1").Offset(i, 25).Value CopyVal15 = x.Sheets("New Report").Range("A1").Offset(i, 26).Value CopyVal16 = x.Sheets("New Report").Range("A1").Offset(i, 28).Value CopyVal17 = x.Sheets("New Report").Range("A1").Offset(i, 30).Value CopyVal18 = x.Sheets("New Report").Range("A1").Offset(i, 32).Value CopyVal19 = x.Sheets("New Report").Range("A1").Offset(i, 33).Value CopyVal20 = x.Sheets("New Report").Range("A1").Offset(i, 35).Value CopyVal21 = x.Sheets("New Report").Range("A1").Offset(i, 40).Value CopyVal22 = x.Sheets("New Report").Range("A1").Offset(i, 41).Value CopyVal23 = x.Sheets("New Report").Range("A1").Offset(i, 49).Value CopyVal24 = x.Sheets("New Report").Range("A1").Offset(i, 50).Value CopyVal25 = x.Sheets("New Report").Range("A1").Offset(i, 46).Value CopyVal26 = x.Sheets("New Report").Range("A1").Offset(i, 48).Value CopyVal27 = x.Sheets("New Report").Range("A1").Offset(i, 43).Value CopyVal28 = x.Sheets("New Report").Range("A1").Offset(i, 29).Value CopyVal29 = x.Sheets("New Report").Range("A1").Offset(i, 53).Value CopyVal30 = x.Sheets("New Report").Range("A1").Offset(i, 54).Value CopyVal31 = x.Sheets("New Report").Range("A1").Offset(i, 55).Value CopyVal32 = x.Sheets("New Report").Range("A1").Offset(i, 56).Value CopyVal33 = x.Sheets("New Report").Range("A1").Offset(i, 57).Value CopyVal34 = x.Sheets("New Report").Range("A1").Offset(i, 59).Value CopyVal35 = x.Sheets("New Report").Range("A1").Offset(i, 60).Value CopyVal36 = x.Sheets("New Report").Range("A1").Offset(i, 61).Value CopyVal37 = x.Sheets("New Report").Range("A1").Offset(i, 62).Value CopyVal38 = x.Sheets("New Report").Range("A1").Offset(i, 63).Value CopyVal39 = x.Sheets("New Report").Range("A1").Offset(i, 64).Value y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 38).Value = CopyVal39 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 37).Value = CopyVal38 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 36).Value = CopyVal37 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 35).Value = CopyVal36 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 34).Value = CopyVal35 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 33).Value = CopyVal34 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 32).Value = CopyVal33 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 31).Value = CopyVal32 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 30).Value = CopyVal31 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 29).Value = CopyVal30 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 28).Value = CopyVal29 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 27).Value = CopyVal28 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 26).Value = CopyVal27 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 25).Value = CopyVal26 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 24).Value = CopyVal25 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 23).Value = CopyVal24 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 22).Value = CopyVal23 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 21).Value = CopyVal22 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 20).Value = CopyVal21 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 19).Value = CopyVal20 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 18).Value = CopyVal19 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 17).Value = CopyVal18 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 16).Value = CopyVal17 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 15).Value = CopyVal16 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 14).Value = CopyVal15 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 13).Value = CopyVal14 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 12).Value = CopyVal13 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 11).Value = CopyVal12 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 10).Value = CopyVal11 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 9).Value = CopyVal10 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 8).Value = CopyVal9 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 7).Value = CopyVal8 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 6).Value = CopyVal7 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 5).Value = CopyVal6 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 4).Value = CopyVal5 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 3).Value = CopyVal4 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 2).Value = CopyVal3 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 1).Value = CopyVal2 y.Sheets("Unmached").Range("A1048576").End(xlUp).Offset(1, 0).Value = CopyVal Next Application.Calculation = xlCalculationAutomatic '!!!! Application.ScreenUpdating = True '!!! y.Sheets("unmached").Range("A1").Select ActiveWorkbook.Close SaveChanges:=True x.Sheets("New Report").Range("A1").Select ActiveWorkbook.Close SaveChanges:=False MsgBox " Report Generated" End Sub 我用55k行的数字testing了这个，花了大概45s。
我只是将原始数据input到一个数组中，并通过数组循环来将数据放回新的表格中。
你需要确认我是否抓住了正确的牢房等
Option Explicit Sub alignment() Dim x As Workbook Dim y As Workbook Set x = Workbooks.Open("C:\Users\raja\Desktop\New Report.xls") Set y = Workbooks.Open("C:\Users\raja\Desktop\ACQ047.xlsx") y.Sheets("unmached").Range("A2").Activate y.Sheets("unmached").Rows(ActiveCell.Row & ":" & Rows.Count).Delete Shift:=xlUp x.Sheets("New Report").Rows(1).EntireRow.Delete x.Sheets("New Report").Range("A1").EntireRow.Insert Dim Lastrow As Long Lastrow = x.Sheets("New Report").Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False '!!!! Application.Calculation = xlCalculationManual '!!!! Dim DataArray As Variant ReDim DataArray(39) For i = 1 To Lastrow With x.Sheets("New Report").Range("A1") DataArray = Array(.Offset(i, 2).Value, .Offset(i, 6).Value, .Offset(i, 8).Value, _ .Offset(i, 11).Value, .Offset(i, 12).Value, .Offset(i, 14).Value, _ .Offset(i, 16).Value, .Offset(i, 18).Value, .Offset(i, 19).Value, _ .Offset(i, 20).Value, .Offset(i, 21).Value, .Offset(i, 22).Value, _ .Offset(i, 23).Value, .Offset(i, 25).Value, .Offset(i, 26).Value, _ .Offset(i, 28).Value, .Offset(i, 30).Value, .Offset(i, 32).Value, _ .Offset(i, 33).Value, .Offset(i, 35).Value, .Offset(i, 40).Value, _ .Offset(i, 41).Value, .Offset(i, 49).Value, .Offset(i, 50).Value, _ .Offset(i, 46).Value, .Offset(i, 48).Value, .Offset(i, 43).Value, _ .Offset(i, 29).Value, .Offset(i, 53).Value, .Offset(i, 54).Value, _ .Offset(i, 55).Value, .Offset(i, 56).Value, .Offset(i, 57).Value, _ .Offset(i, 59).Value, .Offset(i, 60).Value, .Offset(i, 61).Value, _ .Offset(i, 62).Value, .Offset(i, 63).Value, .Offset(i, 64).Value) End With With y.Sheets("Unmached").Range("A1048576").End(xlUp) Dim ArrayPos As Long For ArrayPos = 0 To 38 .Offset(1, 38 - ArrayPos).Value = DataArray(39 - ArrayPos) Next ArrayPos End With Next i Application.Calculation = xlCalculationAutomatic '!!!! Application.ScreenUpdating = True '!!! y.Sheets("unmached").Range("A1").Select ActiveWorkbook.Close SaveChanges:=True x.Sheets("New Report").Range("A1").Select ActiveWorkbook.Close SaveChanges:=False MsgBox " Report Generated" End Sub
您可以使用以下代码作为示例，了解如何通过仅访问工作表两次来执行此类任务。 一般来说，我尽量避免在VBA中进行复制和粘贴，但是这样可以很好地加快速度
Sub Test() x.Sheets("New Report").Range("A:A,C:C,E:E").Copy y.Sheets("Unmached").Range("A1").PasteSpecial xlPasteAll End Sub
这是根据您的要求的代码。 这将不会超过5-10秒
根据需要更改工作表名称和工作簿名称，并执行一件事，检查范围是否准确。 希望你有这个想法让我知道，如果你仍然面临问题 –
Application.ScreenUpdating = False Dim ws1, ws2 As Workbook Set ws1 = ThisWorkbook Set ws2 = Workbooks.Open("E:\Praveen Behera files\book2.xlsx") 'l is lastrow l = ws1.sheets("Sheet1").range("A500000").end(xlup).row ws1.Sheets("Sheet1").Range("" & "C2:C" & l & ",G2:G" & l & ",I2:I" & l & ",L2:L" & l & ",M2:M" & l & ",O2:O" & l & ",Q2:Q" & l & ",S2:S" & l & ",T2:T" & l & ",U2:U" & l & ",V2:V" & l & ",W2:W" & l & ",X2:X" & l & ",Z2:Z" & l & ",AA2:AA" & l & ",AC2:AC" & l & ",AD2:AD" & l & ",AE2:AE" & l & ",AG2:AG" & l & ",AH2:AH" & l & ",AJ2:AJ" & l & ",AO2:AO" & l & ",AP2:AP" & l & ",AR2:AR" & l & ",AU2:AU" & l & ",AW2:AW" & l & ",AX2:AX" & l & ",AY2:AY" & l & ",BB2:BB" & l & ",BC2:BC" & l & ",BD2:BD" & l & "").Copy Destination:=ws2.Sheets("Sheet1").Range("A2") ws1.Sheets("Sheet1").Range("" & "BE2:BE" & l & ",BF2:BF" & l & ",BH2:BH" & l & ",BI2:BI" & l & ",BJ2:BJ" & l & ",BK2:BK" & l & ",BL2:BL" & l & ",BM2:BM" & l & "").Copy Destination:=ws2.Sheets("Sheet1").Range("AF2") Application.ScreenUpdating = True