Question

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

子更新（）

ActiveSheet.DisplayPageBreaks = False sheet3.Activate

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!")

End Sub

Answer 1

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

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

同样删除。

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

运行此代码时的速度问题

1 个答案: