如果在其他工作表的列中找不到单元格值，则 Excel VBA 删除行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19847289/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA delete row if cell value not found in a column in other sheet
提问by user2966226
I am new to VBA and dealing with a huge data set here. I am trying to get rid of observations that do not meet one criteria. I need to go through each cell of Column1 in Sheet1 (around 200,000 rows) and check if the cell value is among accepted values listed in Column1 in Sheet2 (there are some 3000+ rows there). If it is then move forward, if it's not then the whole row with the cell in Sheet1 needs to be deleted.
我是 VBA 的新手，在这里处理大量数据集。我试图摆脱不符合一个标准的观察结果。我需要遍历 Sheet1 中 Column1 的每个单元格（大约 200,000 行）并检查单元格值是否在 Sheet2 中 Column1 中列出的可接受值中（那里有大约 3000+ 行）。如果是然后向前移动，如果不是，则需要删除 Sheet1 中包含单元格的整行。
The code below does not seem to work properly, for example it does not delete all the rows at once, but has to be run several times, and takes ages. I am not sure if the Find method is doing the right job either. Any help would be highly appreciated!
下面的代码似乎不能正常工作，例如它不会一次删除所有行，而是必须运行多次，并且需要很长时间。我也不确定 Find 方法是否在做正确的工作。任何帮助将不胜感激！
(There are multiple cells in Column1 of Sheet1 that have the same value, and they are ordered according to value, is it also possible to speed up the whole process by deleting all of them at once?)
（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
回答by Netloh
When deleting rows you need to go from bottom to top otherwise you would risk missing some rows (as you have encountered). You should therefore replace...
删除行时，您需要从下到上，否则可能会丢失某些行（如您所见）。因此，您应该更换...
For i = 2 To 200000
...with...
...和...
For i = 200000 To 2 Step -1
...in you code, and it should work as intended.
...在你的代码中，它应该按预期工作。
回答by cjtiger
You can also reset i after the delete command within the if statement to compensate for the removal of the row:
您还可以在 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
