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

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

2 个答案: