Excel VBA - Warum löscht dieses Makro alles

Question

Ich brauche Hilfe mit diesem Makro. Ich habe eine Arbeitsmappe, die ziemlich schlecht formatiert ist, aber jedes Mal, wenn ich sie öffne. Das Ziel besteht unter anderem darin, die nicht leeren Zellen in Spalte B zu finden und die gesamten 2 Zeilen unterhalb und die erste Zeile über jeder dieser aufgefüllten B-Zellen zu löschen.

Die erste Schleife, die ich im Code habe, funktioniert genau so, wie ich es möchte, aber die zweite Schleife scheint nur auf der 1. Instanz einer bevölkerten B-Zelle zu funktionieren, aber dann löscht sie alles darüber, wie 500 Zellen im Wert von Daten.

Kann mir jemand erklären, warum das passiert, und wenn Sie einen Weg finden könnten, beide for Schleifen in 1 zu kombinieren, wäre das auch schön.

Sub test() 

Dim currentSht As Worksheet 
Dim startCell As Range 
Dim lastRow As Long, lastCol As Long 
Dim colNames As Variant 
Dim i As Integer, j As Integer 

Set currentSht = ActiveWorkbook.Sheets(1) 
Set startCell = currentSht.Range("A1") 
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row 
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column 

For i = lastRow To 1 Step -1 
If currentSht.Cells(i, "B").Value <> "" Then 
    currentSht.Cells(i, "B").Offset(1).EntireRow.Delete 
End If 
Next i 

Range("D3").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Selection.Delete Shift:=xlUp 

currentSht.Rows("1:1").EntireRow.Delete 
currentSht.Range("c:d, f:g, i:k").EntireColumn.Delete 
currentSht.Range("A:D").Columns.AutoFit 

For j = lastRow To 2 Step -1 
If currentSht.Cells(j, "B").Value <> "" Then 
    currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete 
End If 
Next j 
End Sub 

Danke

Answer 1

Die zweite Schleife alles löscht, da beim Löschen der Linien above der gefundenen Wert, wobei der Wert nach oben wird bewegt und wieder gefunden werden, eine weitere Löschung ausgelöst wird. Um dies zu beheben, wäre der schnellste Weg sein, um die nächsten beiden Zeilen durch Modifizieren j Überspringen:

For j = lastRow To 2 Step -1 
    If currentSht.Cells(j, "B").Value <> "" Then 
     currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete 
     j = j - 2 
    End If 
Next j 

Es ist wirklich nicht viel, wenn Sie von oben nach unten oder umgekehrt werden Looping. Der einzige Unterschied wäre, wenn zwei Einträge in Spalte B nahe beieinander liegen. In diesem Fall würde die Suchreihenfolge bestimmen, welche gelöscht wird. Aber ist Löschen wirklich das was du willst? Vielleicht könnten Sie den Inhalt der Zeilen .Clear löschen, anstatt sie zu löschen.

edit: hier ist der neue Code ein bisschen

gereinigt

Sub test() 
    Dim currentSht As Worksheet 
    Dim startCell As Range 
    Dim lastRow As Long, lastCol As Long 
    Dim colNames As Variant 
    Dim i As Integer, j As Integer 

    Set currentSht = ActiveWorkbook.Sheets(1) 
    Set startCell = currentSht.Range("A1") 
    lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row 
    lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column 

    For i = lastRow To 1 Step -1 
     If currentSht.Cells(i, "B").value <> "" Then 
      'reference the row directly 
      currentSht.Rows(i + 1).Delete 
     End If 
    Next i 

    'Do not use selection if you can avoid it 
    Range("D3", Range("D3").End(xlToRight)).Delete Shift:=xlUp 

    currentSht.Rows(1).Delete 
    currentSht.Range("C:D, F:G, I:K").Delete 
    currentSht.Range("A:D").Columns.AutoFit 

    For j = lastRow To 2 Step -1 
     If currentSht.Cells(j, "B").value <> "" Then 
      currentSht.Rows(j - 1).Delete 
      currentSht.Rows(j - 2).Delete 
      j = j - 2 
     End If 
    Next j 
End Sub 

Wenn Sie die Schleifen das Verhalten des Makros kombinieren möchten wird sich ändern, weil der Deletionen, die zwischen den Schleifen geschehen.