Sub 删除机床图号相同行() |
Dim arr, rng As Range, d, i&, p$, irow&, x$ |
Dim s As Single |
s = Timer |
Application.ScreenUpdating = False |
Set d = CreateObject("scripting.dictionary") |
arr = ActiveSheet.UsedRange |
irow = ActiveSheet.UsedRange.Row |
Set rng = Cells(irow + 1, 4) |
If IsArray(arr) = False Then Exit Sub |
For i = UBound(arr) To 2 Step -1 |
x = arr(i, 2) & arr(i, 4) |
If Not d.exists(x) Then d(x) = 1 Else Set rng = Union(rng, Cells(i, 4)) |
Next |
rng.EntireRow.Delete |
Application.ScreenUpdating = True |
MsgBox "操作完成!", vbInformation + vbOKOnly, "提示" |
MsgBox "耗时" & Format(Timer - s, "0.00秒"), , "提示" |
End Sub |