Excel VBA删除行，如果在其他工作表的列中找不到单元格值

我是VBA新手，在这里处理一个庞大的数据集。 我试图摆脱不符合一个标准的观察。 我需要通过Sheet1中的Column1的每个单元格（大约200,000行），并检查单元格值是否在Sheet2的Column1中列出的可接受值之间（这里有3000多行）。 如果它继续向前移动，如果不是，则需要删除Sheet1中单元格的整行。

下面的代码似乎不能正常工作，例如它不会一次删除所有行，但必须运行多次，并且需要很长时间。 我不确定Find方法是否也做了正确的工作。 任何帮助将不胜感激！

（Sheet1的Column1中的多个单元格具有相同的值，并且它们按照值sorting，是否也可以通过一次性删除所有这些单元来加速整个过程？）

Sub DeleteRows 'Deletes rows where one cell does not meet criteria Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Sheet1") Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") Dim criteria As String Dim found As Range Dim i As Long Application.ScreenUpdating = False For i = 2 To 200000 criteria = ws1.Cells(i, 1).Value On Error Resume Next Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole) On Error GoTo 0 If found Is Nothing Then ws1.Cells(i, 1).EntireRow.Delete End If Next i Application.ScreenUpdating = True End Sub 

Answer 1

删除行时，您需要从底部到顶部，否则您可能会丢失一些行（正如您遇到的那样）。 因此，你应该取代…

 For i = 2 To 200000 

…与…

 For i = 200000 To 2 Step -1 

…在你的代码，它应该按预期工作。

Answer 2

您也可以在if语句中的delete命令之后重置i，以补偿删除行：

 For i = 2 To 200000 criteria = ws1.Cells(i, 1).Value On Error Resume Next Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole) On Error GoTo 0 If found Is Nothing Then ws1.Cells(i, 1).EntireRow.Delete i = i-1 End If Next i