vba - 如果在其他工作表的列中找不到单元格值，则 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