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

Question

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

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

（Sheet1的Column1中有多个具有相同值的单元格，并且它们根据值进行排序，是否还可以通过一次删除所有单元格来加快整个过程的速度？）

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