VBA循環遍列來比較每個單元格與變量，並刪除該行，如果它不匹配

Question

我目前正在嘗試創建一個循環，將查看列C從第5行開始，並比較該列中的每個單元格，直到它到達該列中最後使用的單元格。 每個單元格將檢查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循環，抓住下一個行號並重復，直到出現另一個匹配。只有代碼一直拋出執行中斷錯誤。有人可以告訴我我做錯了什麼嗎？

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