VBA Tool zum löschen von Zeilenblöcken

Guten Tag!
Ich bin neu im Forum (und auch in der VBA Programmierung). Nachdem ich einen VBA Grundkurs absolviert habe, konnte ich bereits einige Erfolge erzielen. Allerdings bringt mich mein aktuelles Projekt an meine Grenzen. Aber vielleicht könnt ihr mir weiterhelfen und guten Input geben :)
Eine ausführliche Google Suche konnte mir leider keine befriedigenden Ergebnisse liefern.

Was soll das Makro können?

Es liegen mehrere Excel Sheets vor. Diese enthalten Zeilen mit mehreren Spalten an Daten. In der letzten Spalte sind die relevanten Daten für das Makro. Es gibt in unregelmäßigen Abständen Zeilenblöcke, in denen der Wert der letzten Spalte 0 ist.

Userbild

Das Makro soll diese Zeilenblöcke erkennen und löschen.

Userbild

Der Haken: Die ersten beiden und letzten beiden Zeilen dieser Blöcke sollen bestehen bleiben. Bonusfunktion: manchmal schleichen sich Zahlen im einstelligen Bereich in diese Nullblöcke. Die soll das Tool nach Möglichkeit übergehen und mit löschen.

Das Grundprinzip habe ich mir so gedacht:

- Gesamtlänge des Dokuments bestimmen
- Mit for Schleife von unten nach oben durchgehen
- sobald 0 auftaucht: Anfangspunkt des Blocks setzen
- sobald größer 0: Endpunkt des Blocks setzen
- Block löschen, wenn größer als 4 Zeilen und die ersten beiden und letzten beiden Zeilen behalten
- weiter loopen bis in Zeile 2 angekommen

Das ist aktuelle Schlachtfeld in meinem VBA Modul. Da ist noch sehr viel abstrakter Code drinnen.



Sub Nullwerte_loeschen()



Dim i As Integer 'Bereich in dem Loop läuft

Dim eingabe_user As String

Dim firstrow As Integer 'Erste Reihe des Blocks

Dim lastrow As Integer 'Endreihe des Blocks

Dim finalRow As Integer 'Gesamtlänge des Arbeitsblattes für Start des Check-Loops

Dim ws As Worksheet



'Messagebox mit Erklärung des Makros und Frage nach Ausführung



eingabe_user = MsgBox("Dieses Makro löscht alle Nullwerte. Bitte beachte, dass dies für die aktive Mappe und das aktive Blatt gilt! Möchtest du dieses Makro Ausführen?", vbOKCancel, "Löschen aller Nullwerte")



'start des Hauptloops

If eingabe_user = vbOK Then

    Set ws = ThisWorkbook.ActiveSheet           'Arbeitsblatt und Arbeitsmappe definieren (aktive Mappe mit aktiven Blatt wird gewählt)

    finalRow = Cells(65000, 1).End(xlUp).Row    'Gesamtlänge der Tabelle ermitteln

    For i = finalRow To 2 Step -1               'starten des Check-Loops

        If ws.Cells(i, 10).Value > 2 Then       'Hier ist ein Fehler!

        firstrow = i                            'Startpunkt des Blocks wird gespeichert (Aktuell wird jede Zeile gespeichert, oder keine)

        'Elseif wert über 2 then

        'lastrow bestimmen

        'block löschen

Rows(firstrow & ":" & lastrow).EntireRow.Delete

        'var reseten und weiter hochgehen

        End If

    Next i

    MsgBox "Makro läuft"

Else

    MsgBox "Fehler! Makro wird abgebrochen"

    

End If

End Sub

Lasst uns gerne über eure Ideen und Ansätze diskutieren! Ich freue mich auf euer Feedback.

Hi

keiner Tipp am Rande: wenn du konkret Hilfe haben willst, ist es immer hilfreich, nicht nur Bilder und den Code zu zeigen, sondern gleich die Datei mit den Daten und deinen Codeversuchen mit hochzuladen. Dann können Helfer auch gleich mal was ausprobieren und dann bekommst du meistens auch recht schnell hilfe.

ich würde hier so vorgehen:
im Schritt 1 per Formel mal kennzeichnen, was gelöscht werden muss und was nicht. zunächst einmal ohne irgendwelche Randbedingungen, dh alles was J 0 ist, soll gelöscht werden.
dazu folgende Formel ab K2: =Wenn(J2=0;1;"X")
entscheidend für das weitere vorgehen ist hier, dass wir für die Kennzeichung einmal eine Zahl und einmal einen Text verwenden (welche Werte, ist eigentlich egal), darüber kann man gezielt auf zu löschenden Block (Zahl) und nicht zu löschenden Block (Text) zugreifen.

der Code dafür wäre

With Columns(10).SpecialCells(xlcelltypeconstants, 1).Offset(0, 1)

    .FormulaR1C1 = "=IF(RC10=0,1,""x"")"

    .Formula = .value

End with

das SpecialCells wählt alle Zellen in Spalte J aus, die eine Zahl enthalten, so können wir alle Zellen bestimmen, ohne erst aufwendig erste und letzte Zeile ermitteln zu müssen.
der zweite Schritt eleminiert die formel und wandelt sie in feste Werte um, das brauchen wir, da wir diese Werte nochmal überarbeiten müssen

für den Berabeitungsschritt muss man das Konstrukt der AREA kennen. Während CELLS eine einzelne Zelle ist und RANGE eine beliebige Ansammlung von CELLS ist, ist eine AREA ein rechteckiger lückenloser Zellbereich. die RANGE("A1:B3,A5:B10") besteht aus den AREAS Range("A1:B3") und Range("A5:B10") und man kann jetzt bei so einer beliebig zusammengestetzen RANGE sich entscheiden, ob man eine Schleife über alle Einzelzellen dieser Range laufen lassen will, oder eine Schleife über alle AREAS, also alle lückenlos zusammenhängende Zellblöcke.
In Spalte 11 haben wir ja Zahlen und Texte, diese kann man über SpecialCells getrennt selektieren, so dass eine Range entsteht, die mehrere Areas enthält.

die nächste Bedingung war, dass Blöcke, die nur aus Zahlen kleiner 10 (einstellig) in Spalte J bestehen, auch gelöscht werden sollen
dh wir machen eine Schleife über alle Blöcke, die mit "x" gekennzeichnet sind und prüfen, welche Zahlen da in Spalte J stehen:

dim A as Range

for each A in columns(11).SpecialCells(xlcelltypeconstants, 2).Areas'2 = Texte (also unser x)

    if worksheetfunction.Max(A.Offset(0, 1))  10 Then A.Value = 1

next

so jetzt löschen wir die bereiche.
das stehenlassen der ersten und letzten zeilen löst man, in dem man die Größe des Bereichs anpasst und diesen verschiebt.

for each A in columns(11).SpecialCells(xlcelltypeconstants, 1).Areas

    if A.Rows.Count > 4 Then A.offset(0, 2).Resize(A.Rows.Count - 4).EntireRow.Delete

next

damit sollte die Aufgabe dann gelöst sein.

Gruß Daniel

VBA Tool zum löschen von Zeilenblöcken

Forumthread: VBA Tool zum löschen von Zeilenblöcken

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Tool zum löschen von Zeilenblöcken

Forumthread: VBA Tool zum löschen von Zeilenblöcken

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread