如何把同一列中的相同的内容的单元格所在行删除，求VBA解决办法。

Question

因数据筛选庞大，求VBA解决办法，要求能够在2003及以上版本中使用。

问题：一个工作簿中有5个工作表，表名为“表一”……“表四”以及“数据筛查”，要求从“数据筛查”表的B列中筛查是否有与“表一”到“表四”中的B列有相同的数据，如果有，在表“数据筛查”中删除掉重复项所在的行。

目的：工作簿中的任一表格B列不会出现重复的内容即可。

较急，请高手帮助，在线等，多谢！

Answer 1

Sub 筛选()
Dim I, X, Y As Integer
Dim Flag As Boolean
Sheets("数据筛查").Select
X = ActiveCell.SpecialCells(xlLastCell).Row

For I = 2 To X
Flag = False
Y = 2
Do While Flag = False And Sheets("表一").Cells(Y, 2) <> ""
If Cells(I, 2) = Sheets("表一").Cells(Y, 2) Then
Cells(I, 2).Delete 3
I = I - 1
Flag = True
Exit Do
End If
Y = Y + 1
Loop

Y = 2
Do While Flag = False And Sheets("表二").Cells(Y, 2) <> ""
If Cells(I, 2) = Sheets("表二").Cells(Y, 2) Then
Cells(I, 2).Delete 3
I = I - 1
Flag = True
Exit Do
End If
Y = Y + 1
Loop

Y = 2
Do While Flag = False And Sheets("表三").Cells(Y, 2) <> ""
If Cells(I, 2) = Sheets("表三").Cells(Y, 2) Then
Cells(I, 2).Delete 3
I = I - 1
Flag = True
Exit Do
End If
Y = Y + 1
Loop

Y = 2
Do While Flag = False And Sheets("表四").Cells(Y, 2) <> ""
If Cells(I, 2) = Sheets("表四").Cells(Y, 2) Then
Cells(I, 2).Delete 3
I = I - 1
Flag = True
Exit Do
End If
Y = Y + 1
Loop

Next I

End Sub追问

大哥，你这个很好用，但是有个问题，如果数据很少的时候，很快就筛选完了，但是程序还没有跑完，能帮我改改吗？比如，遇到空白就停。

追答

我是按你表“数据筛查”最后一个单元格的位置设置结束点的，如果出现你说的情况，说明你这个“数据筛查”表后面有很多别的无用的行。最后一个单元格在什么位置，可以用Ctrl+End测试一下。

可以在：For I = 2 To X
之后加一句语句如下：If Cells(I, 2)="" then exit for