Supprimer les lignes si la valeur n'est pas mentionnée dans la gamme

Question

Sur un fichier avec environ 50.000 lignes que je veux supprimer des lignes qui ne disposent pas d'un nombre spécifique dans la colonne B. J'utilise ce code:

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 

Cette macro prend beaucoup de temps et il semble y avoir un maximum de 'et-déclarations'.

J'ai essayé de comprendre avec un tableau ou un filtre, mais c'est difficile pour moi en tant que débutant.

Je voudrais mettre les chiffres sur une feuille séparée comme plage par exemple:

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

J'ai essayé de le comprendre à l'article critères varient sur une autre feuille * sur https://www.rondebruin.nl/win/winfiles/MoreDeleteCode.txt, mais Je ne comprends pas complètement ce code VBA.

Quelqu'un peut-il m'aider s'il vous plaît? Cordialement, Richard

Answer 1

Supposons que les valeurs sont comme dans le code ci-dessous - rngCheck et rngDelete.

Une boucle imbriquée peut faire exactement ce travail. La boucle externe traverse la plage, qui doit être supprimée rngDelete et l'intérieur passe par les valeurs de contrôle rngCheck.

Si une valeur correspondante est trouvée, elle est supprimée et la boucle interne est quittée. Pour autant que nous Boucler dans les lignes et nous devons supprimer certains d'entre eux, la boucle est avec comptage inverse:

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

est ici une approche de tableau qui permet d'économiser à la lecture et l'écriture sur les feuilles de calcul et doivent donc être un peu plus vite. Cette méthode inclut les cellules qui correspondent plutôt que d'exclure celles qui ne le font pas. Ajustez votre gamme de cellules contre lesquelles vous vérifiez en conséquence. J'ai supposé que vos données commencent dans A1 de la feuille 2016.

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