0

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

我不认为硬件是问题，因为运行 Excel 2007 的计算机是具有 2 gigs ram 的 Pentium 4，而运行 2010 的计算机是具有 8 gigs 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 年运行时间会有如此大的差异？

4

1 回答 1

2

这是你想要做的吗？

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
于 2012-05-30T19:39:44.440 回答