Question

我有一些代码可以在Excel 2007中正常运行，但在Excel 2010中使用时运行时间大约需要十倍，并导致整个任务栏/其他程序无响应。

我不认为硬件是问题，因为运行Excel 2007的计算机是Pentium 4，有2台公羊，而运行2010的计算机是i7，有8台公羊。

以下是代码本身：

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

VBA Excel代码运行速度比2007年快得多

1 个答案: