刪除行如果值不在範圍內

Question

擁有約50.000行提到出文件的我要刪除那些沒有在列B的具體數量我使用此代碼行：

Sub DelRows() 

Application.ScreenUpdating = False 

Worksheets("2016").Activate 

lastrow = Cells(Rows.Count, "A").End(xlUp).Row 

For i = lastrow To 2 Step -1 
If Cells(i, "B").Value <> "1060" And _ 
Cells(i, "B").Value <> "1061" And _ 
Cells(i, "B").Value <> "1062" And _ 
Cells(i, "B").Value <> "1063" And _ 
Cells(i, "B").Value <> "1064" And _ 
Cells(i, "B").Value <> "1105" And _ 
Cells(i, "B").Value <> "11050" And _ 
Cells(i, "B").Value <> "11051" And _ 
Cells(i, "B").Value <> "11053" And _ 
Cells(i, "B").Value <> "11054" And _ 
Cells(i, "B").Value <> "1160" And _ 
Cells(i, "B").Value <> "1161" And _ 
Cells(i, "B").Value <> "1162" And _ 
Cells(i, "B").Value <> "1163" And _ 
Cells(i, "B").Value <> "1164" And _ 
Cells(i, "B").Value <> "1166" And _ 
Cells(i, "B").Value <> "1168" And _ 
Cells(i, "B").Value <> "1169" And _ 
Cells(i, "B").Value <> "8060" And _ 
Cells(i, "B").Value <> "8061" And _ 
Cells(i, "B").Value <> "8062" And _ 
Cells(i, "B").Value <> "8063" And _ 
Cells(i, "B").Value <> "8064" And _ 
Cells(i, "B").Value <> "8068" And _ 
Cells(i, "B").Value <> "8192" Then 
Cells(i, "B").EntireRow.Delete 
End If 

Next i 

End Sub 

這宏需要很多時間，並且似乎是最多的'和聲明'。

我試圖找出一個數組或過濾器，但作爲一個初學者很難。

我想提出的數字在單獨的工作表作爲範圍如：

 A 
1 1060 
2 1061 
3 1062 
4 1063 
5 1064 
… 

我試着部分弄明白條件區域在不同的紙張*上https://www.rondebruin.nl/win/winfiles/MoreDeleteCode.txt，但我不完全理解這個VBA代碼。

有人可以幫我嗎？ 親切的問候， 理查德

Answer 1

假設值如下面的代碼 - rngCheck和rngDelete。

嵌套循環可以完成這項工作。外部循環遍歷範圍，該範圍應該被刪除rngDelete並且內部通過檢查值rngCheck。

如果找到匹配的值，它將被刪除並退出內部循環。至於我們通過行循環，我們需要刪除其中的一些，for循環是反向計數：

Option Explicit 

Public Sub TestMe() 

    Dim cnt   As Long 
    Dim rngDelete As Range 
    Dim rngCheck As Range 
    Dim rngCell  As Range 

    Set rngCheck = Worksheets(2).Range("A1:A2") 
    Set rngDelete = Worksheets(1).Range("A1:A20") 

    For cnt = rngDelete.Rows.Count To 1 Step -1 
     For Each rngCell In rngCheck 
      If rngCell = rngDelete.Cells(cnt, 1) Then 
       rngDelete.Rows(cnt).Delete 
       Exit For 
      End If 
     Next rngCell 
    Next cnt 

End Sub 

Answer 2

這裏是一個數組的辦法，節省了讀取和寫入到電子表格等應該是一個比較快。這種方法包括匹配的單元而不是排除那些不匹配的單元。相應地調整您正在檢查的單元格範圍。我已假設您的數據從2016年的A1開始。

Sub DelRows() 

Dim v, i As Long, j As Long, vOut(), k As Long, rExcl As Range 

Set rExcl = Sheets("Sheet2").Range("A1:A5") 'adjust accordingly 

With Worksheets("2016") 
    v = .Range("A1").CurrentRegion.Value 
    .Range("A1").CurrentRegion.Offset(1).ClearContents 
    ReDim vOut(1 To UBound(v, 1), 1 To UBound(v, 2)) 
    For i = LBound(v, 1) To UBound(v, 1) 
     If IsNumeric(Application.Match(v(i, 2), rExcl, 0)) Then 
      j = j + 1 
      For k = LBound(v, 2) To UBound(v, 2) 
       vOut(j, k) = v(i, k) 
      Next k 
     End If 
    Next i 
    .Range("A2").Resize(j, UBound(v, 2)) = vOut 
End With 

End Sub