求助，怎么把表格里的重复词都删掉

1

数据透视，把数量大于1的筛选掉

数据里面有个删除重复项

用辅助列，条件计数

Sub KK()
Dim x, y
For x = 1 To Range("A65536").End(xlUp).Row
y = Application.CountIf(Range("a:a"), Cells(x, 1))
Range("b" & x) = y
Next x
For x = Range("b65536").End(xlUp).Row To 1 Step -1
If Cells(x, 2) > 1 Then
Rows(x).Delete
End If
Next x
Columns("B:B").Select
Selection.ClearContents
[b1].Select
End Sub
数据量大的话，用循环有点慢，坐等大神优化，@硫酸下

Sub KKkk()
t = Timer
Application.ScreenUpdating = True
Dim x, y
Dim sr As String, sr1 As String
For x = 1 To Range("A65536").End(xlUp).Row
y = Application.CountIf(Range("a:a"), Cells(x, 1))
Range("b" & x) = y
Next x
Set Rng = Rows(65536)
For x = Range("b65536").End(xlUp).Row To 1 Step -1
If Cells(x, 2) > 1 Then
Set Rng = Union(Rng, Rows(x))
End If
Next x
Rng.Delete
Columns("B:B").Select
Selection.ClearContents
[b1].Select
Application.ScreenUpdating = False
MsgBox Timer - t
End Sub