VBA Excel代码在2010年的运行速度比2007年慢得多

VBA Excel代码在2010年的运行速度比2007年慢得多,vba,excel-2007,excel-2010,Vba,Excel 2007,Excel 2010,我有一些代码在Excel2007中运行得很好,但在Excel2010中使用时,运行时间大约要长十倍,并导致整个任务栏/其他程序没有响应 我不认为硬件是问题所在,因为运行Excel2007的计算机是一台奔腾4,内存为2千兆,而运行2010的计算机是一台i7,内存为8千兆 以下是代码本身: Sub Macro6() With Application .ScreenUpdating = False 'Prevent screen flickering .Calc

我有一些代码在Excel2007中运行得很好,但在Excel2010中使用时,运行时间大约要长十倍,并导致整个任务栏/其他程序没有响应

我不认为硬件是问题所在,因为运行Excel2007的计算机是一台奔腾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年,运行时间会有如此大的差异?

这就是您想要做的吗

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

各处理器的MHz是多少?VBA未针对多线程进行优化core@Mike:您的代码很慢,因为您使用了大量的
。请选择
。直接执行该操作,而不是选择单元格。当你说
MSA=ActiveCell
你指的是哪张表和哪一个单元格?@SiddharthRout我在A3单元格的“wip”表上,而“Sheet1”表选择了C3。你能解释一些代码吗?我有点搞不清楚到底发生了什么。你想让我解释一下哪一部分:)?请解释一下.Range和.Cells部分!:DI已经对上面的代码进行了注释。如果您仍然被卡住,请告诉我:)别忘了VBA和Excel之间的交互有时间限制。我很确定您可以进一步重构它,一次读取所有工作表数据,然后在另一个操作中写入所有数据。