Question

我的代码需要一段时间才能运行。我想将结果从一张（wbkorigin）复制到几张（很多wbkdestination）。我已经尝试了一张到另一张（1比1），它真的需要一段时间才能运行。你能帮我优化我的代码吗？谢谢！

Option Explicit
Sub update()
    Dim wkbkorigin As Workbook
    Dim wkbkdestination As Workbook
    Dim originsheet As Worksheet
    Dim destsheet As Worksheet

    Set wkbkorigin = ActiveWorkbook

    Set wkbkdestination = Workbooks.Open("link to worksheet")

    Set originsheet = wkbkorigin.Worksheets("sheet1")
    Set destsheet = wkbkdestination.Worksheets("Sheet1")
    originsheet.Range("D4:Q5").Copy
    destsheet.Range("A1").PasteSpecial
    wkbkdestination.Close SaveChanges:=True

End Sub

Answer 1

也许这会加速一点：

Sub update()

    'Put calculation to xlCalculationManual and screenupdating to Off
    Dim calcState As XlCalculation
    calcState = Application.Calculation
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim wkbkorigin As Workbook
    Dim wkbkdestination As Workbook
    Dim originsheet As Worksheet
    Dim destsheet As Worksheet

    Set wkbkorigin = ActiveWorkbook

    Set wkbkdestination = Workbooks.Open("link to worksheet")

    Set originsheet = wkbkorigin.Worksheets("sheet1")
    Set destsheet = wkbkdestination.Worksheets("Sheet1")

    'Copy/Paste in one step
    originsheet.Range("D4:Q5").Copy destsheet.Range("A1")

    Application.Calculate
    Application.ScreenUpdating = True
    Application.Calculation = calcState

    wkbkdestination.Close SaveChanges:=True

End Sub

1）将计算结果放到手册中;
2）ScreenUpdating关闭;
3）复制/粘贴一步，因为你不使用pastespecial选项（我不认为这条线会加快过程，但它更干净）

将结果从一个工作簿复制到另一个工作簿

1 个答案: