For-Schleife Löschen von Zeilen nicht funktioniert, müssen Makro mehrfach

Question

Arbeitsumgebung auszuführen: Excel 2013
Ziel: 2. durch Filtern der Inhalte in Zeile löschen Sie die nicht benötigten Spalten ist

Meine Idee, dass als solange der Inhalt in Zeile 2 entweder

• Physical Location oder
• PLC Tag Name oder
• Test Step1/2/3/4/5/6/7,

behalten Sie diese Spalten, andernfalls löschen Sie sie.

Mein Problem ist, dass ich dieses Makro mehrmals ausführen muss, um alle nicht benötigten Spalten zu löschen. Es sollte eine Schleife von 1 bis 40 sein und einfach die Spalten lassen, die ich möchte. Ich bin mir nicht sicher, warum es nicht funktioniert. Kann mir jemand helfen? Vielen Dank!

Mein Code:

Sub Reorder() 
    Rows(1).Insert shift:=xlShiftDown 

    For i = 1 To 40 
     WY = Worksheets("Sheet4").Cells(2, i) 
     Select Case WY 
      Case "Physical Location" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "PLC Tag Name" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step1" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step2" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step3" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step4" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step5" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step6" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case "Test Step7" 
       Worksheets("Sheet4").Cells(1, i) = 1 
      Case Else 
       Worksheets("Sheet4").Cells(1, i) = 0 
     End Select 
    Next i 

    For i = 1 To 40 
     If Worksheets("Sheet4").Cells(1, i) = 0 Then 
      Columns(i).EntireColumn.Delete 
     End If 
    Next 
End Sub 

Answer 1

Wenn Sie Zeilen in einer Schleife löschen, müssen Sie von unten beginnen. Andernfalls verringert sich die Zeilennummer der Zeilen unter der tatsächlich gelöschten Zeile um eins und i wird um eins erhöht (aus der Schleife), also vermissen Sie in der Summe eine Zeile.

anstelle von

For i = 1 To 40 

Verwendung

For i = 40 To 1 Step -1 
    If Worksheets("Sheet4").Cells(1, i) = 0 Then 
     Columns(i).EntireColumn.Delete 
    End If 
Next 

Schleife rückwärts.

---

Randbemerkung: (thx to @ A.S.H)
Sie voll qualifizierte Bereiche/Zellen/Zeilen/Spalten verwenden sollte und nie das Arbeitsblatt übernehmen. Deklarieren Sie auch alle Ihre Variablen mit der Option explizit.

Deshalb

Rows(1).Insert shift:=xlShiftDown 
'... 
Columns(i).EntireColumn.Delete 

sollte

Worksheets("Sheet4").Rows(1).Insert shift:=xlShiftDown 
'... 
Worksheets("Sheet4").Columns(i).EntireColumn.Delete 

Also in Summe werden wir bei

Option Explicit 'first line in module 

Public Sub Reorder() 
    Dim i As Long 
    Dim WY As Worksheet 

    Set WY = Worksheets("Sheet4") 

    WY.Rows(1).Insert shift:=xlShiftDown 

    For i = 1 To 40 
     Select Case WY.Cells(2, i) 
      Case "Physical Location", "PLC Tag Name", "Test Step1", "Test Step2", _ 
       "Test Step3", "Test Step4", "Test Step5", "Test Step6", "Test Step7" 
       WY.Cells(1, i) = 1 
      Case Else 
       WY.Cells(1, i) = 0 
     End Select 
    Next i 

    For i = 40 To 1 Step -1 
     If WY.Cells(1, i) = 0 Then 
      WY.Columns(i).EntireColumn.Delete 
     End If 
    Next 
End Sub 

am Ende Oder wenn wir verwenden nur eine Schleife, die viel schneller ist:

Option Explicit 'first line in module 

Public Sub Reorder() 
    Dim i As Long 
    Dim WY As Worksheet 

    Set WY = Worksheets("Sheet4") 

    WY.Rows(1).Insert shift:=xlShiftDown 

    For i = 40 To 1 Step -1 
     Select Case WY.Cells(2, i) 
      Case "Physical Location", "PLC Tag Name", "Test Step1", "Test Step2", _ 
       "Test Step3", "Test Step4", "Test Step5", "Test Step6", "Test Step7" 
       WY.Cells(1, i) = 1 
      Case Else 
       WY.Columns(i).EntireColumn.Delete 
     End Select 
    Next i 
End Sub