|
Sub 删除2()
On Error Resume Next '// 发生错误,自动执行下一句,就是忽略错误
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
Application.EnableEvents = False '//禁止触发其他事件
Application.StatusBar = True '关闭系统状态条
Dim arr()
Dim Rown%, X%, Y%, tim
tim = Timer
Rown = Range("F" & Rows.Count).End(xlUp).Row
ReDim arr(1 To Rown, 1 To 3)
arr = Range("F1").Resize(Rown, 3).Value
For X = 1 To Rown
For Y = 1 To Rown
If arr(X, 2) = arr(Y, 3) And arr(X, 1) = arr(Y, 1) Then
Rows(X).Clear
Rows(Y).Clear
End If
Next Y
Next X
Range("F1:F" & Rown).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
MsgBox Timer - tim
Application.StatusBar = False '恢复系统状态条
Application.EnableEvents = True '// '//恢复触发其他事件
Application.ScreenUpdating = True '//恢复屏幕刷新
Application.DisplayAlerts = True '//恢复系统提示
End Sub
这个秒杀,注意表中F列编号不一样,要修改! |
|