VBA遍历列以将每个单元格与变量进行比较，如果不匹配则删除该行

Question

我目前正在尝试创建一个循环，该循环将从第 5 行开始查看 C 列，并比较该列中的每个单元格，直到它到达该列中最后使用的单元格。 将针对 8 个变量检查​​每个单元格以查看其是否匹配。如果单元格不匹配任何变量，则必须删除整行。

我目前的尝试是这样的：

Dim AC as long
Dim LastRow as long
AC=5
LastRow= Activesheet.range("A" & Rows.count).end(xlup).row
For AC = 5 To LastRow
            With Cells(AC, "C")
            Do Until Cells(AC, "C").Text = OC1 Or Cells(AC, "C").Text = OC2 Or Cells(AC, "C").Text = OC3 Or Cells(AC, "C").Text = OC4 Or Cells(AC, "C").Text = NC1 Or Cells(AC, "C").Text = NC2 Or Cells(AC, "C").Text = NC3 Or Cells(AC, "C").Text = NC4
                Rows(AC).EntireRow.Delete
            Loop
        End With
    Next AC

这应该确保一旦删除了一行，就会有新的行取代它（例如，删除整个第 5 行会导致第 6 行变成第 5 行）所以它应该在匹配时退出 Do Loop，抓住下一个行号并重复，直到有另一个匹配。只有代码不断抛出执行中断错误。有人可以告诉我我做错了什么吗？

Answer 1

如果您的代码导致了无限循环，并且您的错误仅在您尝试终止无限循环时产生，您可以使用以下代码：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim AC As Long
Dim LastRow As Long
AC = 5
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Do While AC <= LastRow
    If Cells(AC, "C").Text <> OC1 And _
       Cells(AC, "C").Text <> OC2 And _
       Cells(AC, "C").Text <> OC3 And _
       Cells(AC, "C").Text <> OC4 And _
       Cells(AC, "C").Text <> NC1 And _
       Cells(AC, "C").Text <> NC2 And _
       Cells(AC, "C").Text <> NC3 And _
       Cells(AC, "C").Text <> NC4 Then
        Rows(AC).Delete
        LastRow = LastRow - 1
    Else
        AC = AC + 1
    End If
Loop

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

您当前做事方式的问题在于，一旦您靠近 LastRow（假设您已删除任何先前的行），您会看到空白行，因此会无限删除它们。

---

或者，当然，您可以使用更普遍接受的删除行的方式 - 从底部开始向上工作：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim AC As Long
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For AC = LastRow To 5 Step -1
    If Cells(AC, "C").Text <> OC1 And _
       Cells(AC, "C").Text <> OC2 And _
       Cells(AC, "C").Text <> OC3 And _
       Cells(AC, "C").Text <> OC4 And _
       Cells(AC, "C").Text <> NC1 And _
       Cells(AC, "C").Text <> NC2 And _
       Cells(AC, "C").Text <> NC3 And _
       Cells(AC, "C").Text <> NC4 Then
        Rows(AC).Delete
    End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic