alle 4-8te Zeilen löschen

Forumthread: alle 4-8te Zeilen löschen

15.02.2018 17:49:08

Stefan

Hallo zusammen
Ich habe ein sehr großen Report (ca. 200000 Zeilen) und möchte diesen um weit mehr als die Hälfte an Zeilen reduzieren.
Dazu habe ich mir vorgestellt, wie im Bild alle 4-8te Zeile zu löschen.
Im Internet konnte ich ein Script finden, das genau dieses tut.
ABER.... Bei ca.200000 Zeilen braucht das Script tage :-(
Gibt es da eine elegantere / schnellere Lösung?
Anbei die Datei mit dem VBA Script.
(Ich musste die Datei wg. max 300 kB, in 5 Pakete aufteilen)
Wäre super, wenn Ihr da eine Lösung parat hättet.
Danke
Stefan
Userbild

VBA Script


Sub Select4Rows()
Dim myRange As Range
Dim Z, Lz As Long
Lz = Cells(Rows.Count, 1).End(xlUp).Row
Set myRange = Rows(5)
For Z = myRange.Row To 300 Step 8  'zZ nur bis Zeile 300 sonst austauschen gegen Lz
Set myRange = Union(myRange, Rows(Z), Rows(Z + 1), Rows(Z + 2), Rows(Z + 3))
Next Z
'im Momment nur anzeigen
myRange.Select
'Wenn funktioniert dann die Zeilen löschen und myRange.Select löschen
'   myRange.EntireRow.Delete
End Sub

Zip-Files Datei inkl. dem VBA Script
https://www.herber.de/bbs/user/119838.zip
https://www.herber.de/bbs/user/119839.zip
https://www.herber.de/bbs/user/119840.zip
https://www.herber.de/bbs/user/119841.zip
https://www.herber.de/bbs/user/119842.zip
!! Achtung bitte bei den Files "LoescheZeilen.z01.zip bis LoescheZeilen.z04.zip" im Editor die Endung .zip einfach löschen.
Beim entpacken der Datei LoescheZeilen.zip werden dann die einzelnen Dateien gefunden.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: alle 4-8te Zeilen löschen

15.02.2018 18:22:50

Daniel

Hi
Zeilen löschen mit Bedingung macht man am besten so:
1. trage in eine Hilfsspalte eine Formel ein, welche alle Zeilen die stehenbleiben sollen mit der Zeilennummer kennzeichnet und alle die gelöscht werden sollen, mit 0.
In deinem Fall wäre die Formel

=wenn(Rest(Zeile()-1;8)>=4;0;Zeile())

2. schreibe in die Überschriftenzeile der Hilfsspalte die 0
3. wende auf die ganze Tabelle die Funktion Daten - Datentools - Duplikate entfernen an, mit der Hilfsspalte als Kriterium und der Option "keine Überschrift"
4. lösche die Hilfsspalte.
Fertig.
Wenn man es als Makro braucht, programmiert man einfach diesen Ablauf nach.
(Solltest du bei "VBA-gut" hin bekommen, der Recorder hilft dir dabei.)
Im Archiv sollten auch Beispielcodes vorhanden sein, bei denen brauchst du dann nur die Formel anpassen.
Gruß Daniel

AW: wo ist Daniel?

15.02.2018 18:31:06

Fennek

Hallo,
es scheint, dass Daniel heute nicht im Forum ist. Deshalb versuche ich seine SEHR schnelle Formel:


sub fast_delete()
Range("B1:B250000").formula = "=if(rows() mod 8 > 4,0,rows()"
end sub

Dann den Curosr auf B1 stellen und im Menü Daten: Duplikate entfernen
Das sollte nicht länger als 1-2 Sekunden benötigen.
mfg
(ungeprüft, bevor du die Datei überschreibst, prüfe das Ergebnis GENAU)

AW: sorry, zu langsam (owT)

15.02.2018 18:32:18

Fennek

AW: alle 4-8te Zeilen löschen

15.02.2018 19:02:20

Stefan

Hallo Daniel
Ähm.. das sind 197376 Zeilen
Auch mit meinen "VBA = gut" würde ich jetzt wieder eine Schleife über 197376 Zeilen durchlaufen lassen um die Formel in die Zeile einzutragen. :-(
-Markieren, runterziehen...- geht auch nicht :-(
Ich vermute mal, das die Aktion genauso lange dauert, wie mein Makro ?
@Fennek
Die Idee ist nicht schlecht .. funktioniert aber leider nicht :-(
Laufzeitfehler 1004
Gruß
Stefan

AW: alle 4-8te Zeilen löschen

15.02.2018 19:13:44

Daniel

Omg
Dan bist du in Excel aber schlecht.
Würdest du in Excel die Formel in jede Zelle einzeln eintragen?
Wahrscheinlich nein.
Ein guter Excelanwender würde erst alle Zellen markieren, dann die Formel eingeben und die Eingabe mit STRG+ENTER abschließen, um die Formel in alle Zellen gleichzeitig in einem Schritt einzugeben.
In VBA macht man es dann genauso, um sich die langwierige Schleife zu ersparen.
Gruß Daniel

AW: alle 4-8te Zeilen löschen

15.02.2018 19:33:52

Stefan

Zum Abschluss um meine Würde wieder herzustellen :-)
Danke für Eure Tipps
Funktioniert jetzt super.

Sub Select4Rows()
Dim Lz As Long
Lz = Cells(Rows.Count, 1).End(xlUp).Row
Range("C2:C" & Lz).Formula = "=IF(MOD(ROW()-1,8)>=4,0,ROW())"
Range("C1") = "0"
Range("A1:C" & Lz).RemoveDuplicates Columns:=3, Header:=xlYes
Columns("C:C").Delete
End Sub

Gruß
Stefan

AW: alle 4-8te Zeilen löschen

15.02.2018 19:53:21

Daniel

Na also, geht doch.
Bzw, du musst "Header:=xlno" einstellen.
Beim Duplikate-entfernen bleibt ja immer die erste Zeile mit dem Duplikatswert (0) stehen.
Dh die erste zu löschende Zeile wird nicht gelöscht.
Das Problem umgeht man, indem man für diese erste Zeile die Überschrift verwendet.
Das funktioniert aber nur dann, wenn die Überschrift von der Prüfung nicht ausgenommen ist, sondern normaler Teil des Datensatzes ist.
Gruß Daniel

AW: alle 4-8te Zeilen löschen

15.02.2018 20:25:25

Stefan

Ok .. verstanden
Hatte mich schon gewundert, warum die erste 0 nicht gelöscht wurde..
Na ja.. Da erkennt Man(n) den Profi ;-)
Gruß
Stefan

AW: alle 4-8te Zeilen löschen

15.02.2018 19:14:42

Stefan

Hallo Daniel, hallo Fennek
mit dem Befehl:

Lz = Cells(Rows.Count, 1).End(xlUp).Row
Range("C1:C" & Lz).Formula = "=IF(MOD(ROW()-1,8)>=4,0,ROW())

ist das tatsächlich "sau" schnell erledigt.
Funktioniert doch..
Ich probiere noch den Rest hin zu bekommen.
Danke
Stefan

Beliebteste Forumthreads (12 Monate)

Forumthread: alle 4-8te Zeilen löschen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

alle 4-8te Zeilen löschen

Forumthread: alle 4-8te Zeilen löschen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread