Excel VBA将日期从一个工作簿复制到另一个工作簿需要很长时间_Excel_Vba

Excel VBA将日期从一个工作簿复制到另一个工作簿需要很长时间

excel vba

Excel VBA将日期从一个工作簿复制到另一个工作簿需要很长时间,excel,vba,Excel,Vba,我正在尝试使用VBA将数据从一个excel复制到另一个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\ra

我正在尝试使用VBA将数据从一个excel复制到另一个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

您可以使用以下代码作为示例，说明如何通过仅访问工作表两次来执行此类任务。一般来说，我尽量避免在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

我测试了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

一般来说，您希望访问工作表的次数尽可能少。因此，如果您可以将数据（所有30k行）拉入一次，然后输出到新的工作表中，这将是非常快的，因为您的范围不正确，这几乎是我已经提供的答案的重复。这是我自己的答案。休息，让提问者决定范围@Yousuva Raja，请检查范围，如果需要，请检查。嗨，Callum和Praveen，谢谢你的建议。在Q列之后，所有内容都变得混乱，范围被粘贴到不同的列中。但这比我的要快得多。再次感谢您的支持：）嗨，Jean，谢谢您编辑的代码。我对arraypos一无所知。我猜您的数组包含错误的行--x.Sheets（“New Rep2-1ort”）.Range（“A1”）.Offset（I，33）.Value，因此它向我抛出了一个脚本外错误。@YousuvaRaja不确定该行来自何处，我认为它来自您的代码，但我已更正为来自

x.Sheets（“New Report”）.Range（“A1”）.Offset（I，33）.Value

请再次检查。另外，我不确定你的意思是什么，我对arraypos一无所知。

arraypos

只是一个变量，我声明用于从

DaraArray

中提取数据。谢谢Jean，它成功了，只花了不到2分钟的时间：）@YousuvaRaja我很高兴它成功了，记住向上投票并标出你问题的正确答案。嗨，Jean，我是这个网站的新手，我不知道向上投票的地方。。你能帮帮我吗？