运行此代码时的速度问题答案

【问题标题】：speed issue when running this code运行此代码时的速度问题
【发布时间】：2014-07-16 01:43:37
【问题描述】：

这是我的代码。请我需要你的帮助..提前谢谢

子更新()

ActiveSheet.DisplayPageBreaks = False sheet3.激活

Range("A2:AI50").Select
Selection.Delete Shift:=xlUp
Dim ws As Worksheet
Set ws = Sheets(Sheets.Count)
Dim LR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("Sheet1")
    LR = .Range("AI" & .Rows.Count).End(xlUp).Row
    .Range("A1:AI" & LR).Copy ws.Range("A" & ws.Rows.Count).End(xlUp)
End With

With Sheets("Sheet2")
    LR = .Range("AI" & .Rows.Count).End(xlUp).Row
    .Range("A2:AI" & LR).Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1)
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

'---------------------------------------------- ------

ActiveSheet.DisplayPageBreaks = False
Dim cntrl As Integer
Dim CountList As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

CountList = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row

For Each x In Sheets("Sheet1").Range("A2:AI" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
    For cntrl = CountList To 1 Step -1
    If x.Value = Sheets("Sheet3").Cells(cntrl, 1).Value Then
    Sheets("Sheet3").Cells(cntrl, 1).EntireRow.Delete
    Sheets("Sheet3").Range("A2:AI" & Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row).Interior.ColorIndex = 22
End If

Next cntrl
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

'---------------------------------------------- -----

ActiveSheet.DisplayPageBreaks = False
Dim reyng  As Range
Dim up     As Range
Dim cl     As Range
Dim r1     As Long
Dim R      As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With sheet2
    Set reyng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

With sheet3
    Set up = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    R = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

On Error Resume Next
For Each cl In reyng
    If Application.WorksheetFunction.CountIf(up, cl.Value) = 0 Then
        R = R + 1
        cl.EntireRow.Copy sheet3.Cells(R, 1)
        sheet3.Cells(R, 1).Interior.ColorIndex = 40
        sheet3.Cells(R, 2).Interior.ColorIndex = 40
        sheet3.Cells(R, 3).Interior.ColorIndex = 40
        sheet3.Cells(R, 4).Interior.ColorIndex = 40
        sheet3.Cells(R, 5).Interior.ColorIndex = 40
        sheet3.Cells(R, 6).Interior.ColorIndex = 40
        sheet3.Cells(R, 7).Interior.ColorIndex = 40
        sheet3.Cells(R, 8).Interior.ColorIndex = 40
        sheet3.Cells(R, 9).Interior.ColorIndex = 40
        sheet3.Cells(R, 10).Interior.ColorIndex = 40
        sheet3.Cells(R, 11).Interior.ColorIndex = 40
        sheet3.Cells(R, 12).Interior.ColorIndex = 40
        sheet3.Cells(R, 13).Interior.ColorIndex = 40
        sheet3.Cells(R, 14).Interior.ColorIndex = 40
        sheet3.Cells(R, 15).Interior.ColorIndex = 40
        sheet3.Cells(R, 16).Interior.ColorIndex = 40
        sheet3.Cells(R, 17).Interior.ColorIndex = 40
        sheet3.Cells(R, 18).Interior.ColorIndex = 40
        sheet3.Cells(R, 19).Interior.ColorIndex = 40
        sheet3.Cells(R, 20).Interior.ColorIndex = 40
        sheet3.Cells(R, 21).Interior.ColorIndex = 40
        sheet3.Cells(R, 22).Interior.ColorIndex = 40
        sheet3.Cells(R, 23).Interior.ColorIndex = 40
        sheet3.Cells(R, 24).Interior.ColorIndex = 40
        sheet3.Cells(R, 25).Interior.ColorIndex = 40
        sheet3.Cells(R, 26).Interior.ColorIndex = 40
        sheet3.Cells(R, 27).Interior.ColorIndex = 40
        sheet3.Cells(R, 28).Interior.ColorIndex = 40
        sheet3.Cells(R, 29).Interior.ColorIndex = 40
        sheet3.Cells(R, 30).Interior.ColorIndex = 40
        sheet3.Cells(R, 31).Interior.ColorIndex = 40
        sheet3.Cells(R, 32).Interior.ColorIndex = 40
        sheet3.Cells(R, 33).Interior.ColorIndex = 40
        sheet3.Cells(R, 34).Interior.ColorIndex = 40
        sheet3.Cells(R, 35).Interior.ColorIndex = 40
     End If
Next cl
On Error GoTo 0

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

'----------------------------------------

ActiveSheet.DisplayPageBreaks = False
Dim NextRow As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set NextRow = Range("A" & Sheets("Sheet3").UsedRange.Rows.Count + 1)
sheet1.Range("A2:AI50").Copy
sheet3.Activate
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

'--------------------------------------------------------

ActiveSheet.DisplayPageBreaks = False
Dim ListCount As Integer
Dim XCtr      As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

ListCount = Sheets("Sheet3").Range("F2:AI50").Rows.Count
Sheets("Sheet3").Range("F2").Select

Do Until ActiveCell = ""
For XCtr = 1 To ListCount

If ActiveCell.Row <> Sheets("Sheet3").Cells(XCtr, 6).Row Then
If ActiveCell.Value = Sheets("Sheet3").Cells(XCtr, 6).Value Then
Sheets("Sheet3").Cells(XCtr, 1).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 2).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 3).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 4).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 5).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 6).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 7).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 8).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 9).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 10).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 11).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 12).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 13).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 14).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 15).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 16).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 17).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 18).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 19).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 20).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 21).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 22).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 23).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 24).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 25).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 26).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 27).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 28).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 29).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 30).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 31).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 32).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 33).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 34).Delete xlUp
Sheets("Sheet3").Cells(XCtr, 35).Delete xlUp
XCtr = XCtr + 1
End If
End If

Next XCtr
ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("Updated!")

结束子

【问题讨论】：

标签： excel vba macos

【解决方案1】：

而不是一个一个地对每个单元格应用颜色和删除为什么不一次为单元格范围着色。这会提高您的代码性能。

sheet3.Range(Cells(R, 1),Cells(R,35).Interior.ColorIndex = 40

删除也一样。

sheet3.Range(Cells(XCtr, 1),Cells(XCtr, 35)).Delete xlUp

【讨论】：