Sub DeleteSameRow1()
Dim LastRow As Long
Dim i, k, n As Long
Dim arr, brr()
Dim str As String
Dim d As Object
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
arr = Sheets("Sheet1").Range("A2:f" & LastRow)
For k = 1 To UBound(arr)
str = arr(k, 1)
If Not d.exists(str) Then
d(str) = ""
Else
n = n + 1
ReDim Preserve brr(1 To n)
brr(n) = k + 1
End If
Next
For i = n To 1 Step -1
Cells(brr(i), 1).EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub
用数组去除数组之间的重复值
最新推荐文章于 2023-10-14 18:30:58 发布