0

Excel 2007 では正常に動作するコードがいくつかありますが、Excel 2010 で使用すると、実行に約 10 倍の時間がかかり、タスクバーやその他のプログラム全体が応答しなくなります。

Excel 2007 を実行しているコンピューターは 2 GB の RAM を搭載した Pentium 4 であり、2010 を実行しているコンピューターは 8 GB の 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 に答える