VBA Excel代碼運行速度比2007年慢很多

Question

我有一些在Excel 2007中運行良好的代碼，但在Excel 2010中使用時需要運行約10倍的時間並導致整個任務欄/其他程序無響應。

我不相信硬件是問題，因爲運行Excel 2007的計算機是Pentium 4，具有2個RAM的演出，而運行2010的計算機是具有8個RAM演出的i7。

這裏是代碼本身：

Sub Macro6() 
    With Application 
     .ScreenUpdating = False 'Prevent screen flickering 
     .Calculation = xlCalculationManual 'Preventing calculation 
     .DisplayAlerts = False 'Turn OFF alerts 
     .EnableEvents = False 'Prevent All Events 
    End With 

    Dim i As Integer 
    Dim j As Integer 
    Dim Anc As String 
    Dim MSA As String 

    j = 1 

    Do 
     i = 0 
     MSA = ActiveCell 
     Selection.Copy 
     Sheets("Sheet1").Select 
     ActiveCell.Offset(0, -2).Select 
     ActiveSheet.Paste 
     ActiveCell.Offset(0, 2).Select 
     Sheets("wip").Select 
     Do 
      i = i + 1 
      ActiveCell.Offset(0, 1).Select 
      Anc = ActiveCell.Offset(-j, 0) 
      Selection.Copy 
      Sheets("Sheet1").Select 
      ActiveCell.Offset(0, -1) = Anc 
      ActiveCell.Offset(0, -2) = MSA 
      ActiveSheet.Paste 
      ActiveCell.Offset(1, 0).Select 
      Sheets("wip").Select 

     Loop Until IsEmpty(ActiveCell.Offset(0, 1)) 
     j = j + 1 
     ActiveCell.Offset(1, -i).Select 
    Loop Until IsEmpty(ActiveCell) 

    'Speeding Up VBA Code 
    With Application 
     .ScreenUpdating = True 'Prevent screen flickering 
     .Calculation = xlAutomatic 'Preventing calculation 
     .DisplayAlerts = True 'Turn OFF alerts 
     .EnableEvents = True 'Prevent All Events 
    End With 
End Sub 

的代碼做什麼，我也想，但我擔心，爲什麼在2010年，在運行時間這樣的區別？

Answer 1

這是你正在嘗試做什麼？

Option Explicit 

Sub Sample() 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim i As Long, j As Long, k As Long, lRow As Long, lCol As Long 

    On Error GoTo Whoa 

    With Application 
     .ScreenUpdating = False 
     .Calculation = xlCalculationManual 
     .EnableEvents = False 
    End With 

    '~~> Setting the worksheets to work with 
    Set ws1 = Sheets("wip"): Set ws2 = Sheets("Sheet1") 

    '~~> Setting the start cell in "Sheet1" 
    k = 3 

    With ws1 
     '~~> Get the last row in Col A of "wip" 
     lRow = .Range("A" & .Rows.Count).End(xlUp).Row 
     '~~> Get the last column in row 3 of "wip" 
     lCol = .Cells(3, .Columns.Count).End(xlToLeft).Column 

     '~~> Looping through rows in Col A in "wip" 
     For i = 3 To lRow 
      '~~> Looping through columns in the relevant row in "wip" 
      For j = 3 To lCol + 1 
       '~~> Writing output directly in "Sheet1" 
       ws2.Cells(k, 1).Value = ws1.Cells(i, 1).Value 
       ws2.Cells(k, 3).Value = ws1.Cells(i, 1).Offset(, j - 2).Value 
       k = k + 1 
      Next j 
     Next i 
    End With 

LetsContinue: 
    With Application 
     .ScreenUpdating = False 
     .Calculation = xlCalculationManual 
     .EnableEvents = False 
    End With 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub