vba删除满足条件指定行

Question

A1 张三
A2 张三
A3 张三
A4 王五
A5 李四
A6 王五

条件1 当 range(A2)=RANGE(A1)时 删除A1所在行
条件2 不要删除不相邻的相同值

结果成这样
A1 张三
A2 王五
A3 李四
A4 王五

万分感谢 数据量有大约30多万。。。只能用VBA了。。

Answer 1

Sub cscs()
Dim i%
For i = Range("a" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 1) = Cells(i + 1, 1) Then Rows(i).Delete
Next
End Sub

Answer 2

Sub a()
Dim i&, n&, r&, arr()
r = Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr(1 To r, 1 To 1)
n = 1
For i = 1 To r
If i = 1 Then arr(1, 1) = Cells(1, 1)
If Cells(i, 1) > Cells(i + 1, 1) And Cells(i + 1, 1) > "" Then
n = n + 1
arr(n, 1) = Cells(i + 1, 1)
End If
Next
Columns(2).ClearContents
Range("b1").Resize(r) = arr
End Sub

Answer 3

Sub 去重()
On Error Resume Next
For i = [b65536].End(3).Row To 1 Step -1
If Cells(i, 2) = Cells(i - 1, 2) Then
    Rows(i - 1 & ":" & i - 1).Delete Shift:=xlUp
End If
Next
End Sub

追问

把 On Error Resume Next 删掉之后 运行错误1004 语句写得有问题吧
For i = [b65536].End(3).Row To 1 Step -1 从最后开始往上数
If Cells(i, 2) = Cells(i - 1, 2) Then 如果相同 则
Rows(i - 1 & ":" & i - 1).Delete Shift:=xlUp ？？？这是什么意思

追答

Rows(i - 1 & ":" & i - 1).Delete Shift:=xlUp

删除相同两行的上面一行同时下面的行上移。

追问

但是你写得这个跑不动哦 运行错误1004 貌似哪里写错了？

Answer 4

Public Sub DeleteAdjacentDuplicateDateRows()
For i＝1000 To 1 Step －1
If cells(i+1,1)＝Cells(i,1) Then
Rows(i).Delete
End If
Next i
End Sub

Answer 5

不必使用VBA的，在B1里面输入下面的公式：

=IF(A1=A2,"删除","保留")

下拉到底，然后筛选B列为【删除】的行进行删除即可，示例：

追问

的确可以 但是我还是想知道VBA怎么写 谢谢 毕竟这一次30多万 下次上几百万不用vba会卡死机。。

追答

写得不好的代码会更慢的，

代码1执行界面如下，10万笔18秒（速度与重复程度相关）：

代码2执行速度在1秒之内：



本回答被网友采纳