我正在尝试使用VBA将数据从一个Excel复制到另一个。但它的30K线路耗时超过15分钟。有没有办法让它更快？
我需要将新报表工作簿中的39列与ACQ047 WB对齐。
以下是我的代码：
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
答案 0 :(得分：1)
您可以使用以下代码作为如何通过仅访问工作表两次来执行此类任务的示例。一般来说，我尽量避免在VBA中复制和粘贴，但这样可以加快速度
Sub Test()
x.Sheets("New Report").Range("A:A,C:C,E:E").Copy
y.Sheets("Unmached").Range("A1").PasteSpecial xlPasteAll
End Sub
答案 1 :(得分：1)
我用55k行的数字进行了测试，大约需要45秒。
我只是将原始数据输入到一个数组中，然后通过数组循环将数据放回到新工作表中。
您需要确认我是否捕获了正确的细胞等。
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
答案 2 :(得分：0)
这是符合您要求的代码。这不会超过5-10 SECONDS
根据需要更改工作表名称和工作簿名称并执行一项操作，检查范围是否准确。希望你有这个想法让我知道你是否仍然面临问题 -
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