Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1592to1596
1592to1596
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA erweitern: Zeilen löschen

Forumthread: VBA erweitern: Zeilen löschen

VBA erweitern: Zeilen löschen
21.11.2017 14:31:36
Kisska
Servus!
Mit dem folgenden Code lösche ich alle Zeilen, wo in der 2. Spalte nach der Überschrift etwas anderes steht als "Text1": 

Sub Filter()
Application.ScreenUpdating = False
Dim iRow As Single
Dim i As Single
Range("A1", Range("a65536").End(xlUp)).Select
iRow = ActiveSheet.UsedRange.Rows.Count
'Auswahl Anfangszelle
Cells(2, 2).Select
For i = iRow To 2 Step -1
If Cells(i, 2).Value  "Text1" Then
Cells(i, 1).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Könnte mir bitte jemand helfen, den Code zu erweitern: Es sollen die Zeilen bleiben, wo in der 2. Spalte nicht nur "Text1" steht, sondern mehr, bspw. "Text4", "Text7" und "Text9" - also 4 Suchkriterien.
Viele Grüße
Kisska
Anzeige

36
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA erweitern: Zeilen löschen
21.11.2017 15:09:57
Ulf
Moin,
ungetestet:
Sub Filter()
Application.ScreenUpdating = False
Dim iRow As Single
Dim i As Single
Range("A1", Range("a65536").End(xlUp)).Select
iRow = ActiveSheet.UsedRange.Rows.Count
'Auswahl Anfangszelle
Cells(2, 2).Select
For i = iRow To 2 Step -1
If Cells(i, 2).Value  "Text1" Or "Text4" Or "Text7" Or "Text9" Then
Cells(i, 1).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Gruß
Ulf
Anzeige
das wird so nichts
21.11.2017 16:23:23
Werner
Hallo Ulf,
so wie bei dir 
If Cells(i, 2).Value  "Text1" Or "Text4" Or "Text7" Or "Text9" Then
wird das nichts. Wenn schon, dann müsste das so lauten: 
If Cells(i, 2).Value  "Text1" Or Cells(i, 2).Value  "Text2"  _
Or Cells(i, 2).Value  "Text3" Or Cells(i, 2).Value  "Text4" Then
Gruß Werner
Anzeige
AW: VBA erweitern: Zeilen löschen
21.11.2017 16:16:40
Werner
Hallo Kiska,
da bietet sich Select Case an: 
Public Sub Löschen()
Dim loLetzte As Long, i As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1") 'Blattname anpassen
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = loLetzte To 2 Step -1
Select Case .Cells(i, 2).Value
Case "Text1", "Text2", "Text3", "Text4"
'nix machen
Case Else
Rows(i).Delete
End Select
Next i
End With
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige
'Select Case' wäre eine brauchbarere Wahl, ...
21.11.2017 19:52:34
Luc:-?
…Werner,
wenn die Texte tatsächlich so lauten oder wenigstens ähnlich kurz sind. Sind sie deutlich länger, würde ich ggf mit Join und Instr oder besser mit einem Array aus diesen Texten und .Match arbeiten, was natürlich auch die Alternative für kurze Texte wäre, zumal ja nur 2 Fälle unterschieden wdn müssen: im Array : nicht im Array
Gruß, Luc :-?
„Die Intelligenzmenge ist auf diesem Planeten eine Konstante, die Bevölkerung nimmt aber zu!“ Auch deshalb informieren mit …
Anzeige
AW: VBA erweitern: Zeilen löschen
21.11.2017 20:41:43
Kisska
Hallo Werner,
danke für die Hilfe! Kann man in deinem Code das Tabellenblatt undefiniert lassen, so ähnlich _ wie in meinem geposteten Code, quasi die Zeile 

Worksheets("Tabelle1")
weglassen?
VG
Kisska
AW: VBA erweitern: Zeilen löschen
21.11.2017 20:56:41
Uduuh
Hallo,
dann ersetze Worksheets("Tabelle1") durch ActiveSheet
Gruß aus’m Pott
Udo

Anzeige
klasse, danke!
21.11.2017 23:01:43
Kisska
Danke Udo!
noch eine kleine Frage
22.11.2017 13:23:46
Kisska
Hallo Werner,
wenn ich zusätzlich zu der Spalte B noch über die Spalte D eine Löschung nach bspw. "Nr1" und "Nr2" vornehmen möchte, sollte man deinen Code zwei Mal hintereinander schreiben oder sollte man alles in einem Code schreiben - ändert sich dadurch die Performance wenn man viele Datensätze hat?
Viele Grüße
Kisska
Anzeige
Beispielmappe
22.11.2017 15:03:07
Werner
Hallo Kisska,
was soll passieren?
in B2 steht Text1, in D2 steht Nr. 1 -Zeile löschen oder nicht?
mach mal eine Beispielmappe und trage ein paar Daten ein. Schreib dann dazu welche Zeilen bei welchen Voraussetzungen gelöscht werden sollen. Die Datei dann hier hochladen.
Gruß Werner
Anzeige
AW: Beispielmappe
22.11.2017 18:36:22
Kisska
Hallo Werner,
anbei die Beispielsdatei mit dem VBA-Code:
https://www.herber.de/bbs/user/117845.xlsm
Wenn ich mit deinem Code nur eine Spalte untersuche, dann wird die Löschung der unerwünschten Daten innerhalb von ein paar Sekunden durchgeführt. Wenn ich aber 2 Spalten untersuche - so wie in dieser Beispielsdatei - aber mit einer Datenmenge über 100.000 Zeilen, dann dauert die Prozedur über 5 min.
Nun wollte ich sicher gehen, ob ich deinen Code richtig angewandt habe?
VG
Kisska
Anzeige
AW: Beispielmappe
22.11.2017 23:18:38
Daniel
Hi
für das schnelle Löschen von Zeilen in großen Datenmengen ist meine "interessante" Methode bestens geeignet.
Den Code kennst du ja, du musst nur die Formel noch etwas anpassen, so dass alle Zeilen, die gelöschst werden sollen, mit 0 gekennzeichnet werden und die, die stehen bleiben müssen, mit der aktuellen Zeilennummer (Zeile()).
Also nicht komplizierter als WENN ggf kombiniert mit UND oder ODER, je nach Aufgabenstellung.
Die Formel kannst du ja auch erstmal unabhängig vom Makrocode direkt in Excel erstellen, das fällt dir vielleicht leichter.
Wenn du die Formel dann in Excel hast, kannst du so vorgehen, um dir die Eingabe der Formel als Makrocode zu ermitteln:
1. Recorder starten
2. Zelle mit Formel anklicken
3. F2 drücken um den Bearbeitungsmodus zu starten
4. ENTER drücken
5. Recorder stoppen und aufgezeichneten Code anschauen.
Gruß Daniel
Anzeige
die Methode dauert leider länger
22.11.2017 23:30:16
Kisska
Hallo Daniel,
ich habe beide Methoden - von dir und Werner ausprobiert und komischerweise hat die Prozedur nach deiner Methode fast drei Mal länger gedauert, deshalb habe ich die Finger davon gelassen :)
Das wundert mich sehr
23.11.2017 00:45:58
Daniel
Ich habe da andere Erfahrungen gemacht.
kannst du mal die Codes zeigen, die du verwendest hast und genauer beschreiben, wie die zu bearbeitende Datei tatsächlich aussieht, dh wieviele Zeilen, vieviele Spalten sind belegt?
Welcher Anteil der Zeilen muss gelöscht werden, welcher Anteil bleibt stehen?
Gibt es Formeln in der Datei?
Wie lang sind die Texte, nach denen du suchst?
gibt es in andern Tabellen formeln, die sich auf die bearbeitete Tabelle beziehen?
ich selber habe mal die Leistung beider Methoden mit diesem Versuchstaufbau verglichen:
Sub test()
Dim t As Double
Call szenario
t = Timer
Call Löschen_Mit_Schleife
Debug.Print "Schleife: "; Timer - t,
Call szenario
t = Timer
Call Löschen_Mit_REMOVEDUPLICATES
Debug.Print "RemDupl:"; Timer - t
End Sub
Sub szenario()
Cells.Clear
With Cells(1, 1).Resize(100000, 3)
.Columns(1).Value = "xxx"
.Columns(2).Formula = "=""Text""&Mod(Row(),8)+1"
.Columns(2).Formula = .Columns(2).Value
.Columns(3).Value = "xxx"
End With
End Sub
Public Sub Löschen_Mit_Schleife()
Dim loLetzte As Long, i As Long
Application.ScreenUpdating = False
With ActiveSheet 'Blattname anpassen
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = loLetzte To 2 Step -1
Select Case .Cells(i, 2).Value
Case "Text1", "Text2", "Text3", "Text4"
'nix machen
Case Else
Rows(i).Delete
End Select
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub Löschen_Mit_REMOVEDUPLICATES()
With ActiveSheet.Cells(1, 1).CurrentRegion
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(IsNumber(Find(""|""&RC2&""|"",""|Text1|Text2|Text3|Text4|"")),Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
End Sub
das Makro "Szenario" erzeugt eine Testtabelle, in der sich in Spalte B die Texte "Text1" bis "Text8" immer wiederholen (entsprechend der vorgegebenen Anzahl an Zeilen), dh es werden 50% der Zeilen gelöscht.
das Makro TEST ruft dann erst das Szenario-Makro auf und das jeweilige Lösch-Makro und stoppt dabei die Bearbeitungszeit (dh TEST muss auch gestartet werden)
Das Ergebnis wird dann im Direktfenster ausgegeben.
bei mir ist das DuplikateEntfernen deutlich schneller.
Gruß Daniel
Anzeige
mich auch
23.11.2017 10:06:20
Werner
Hallo Daniel,
würde mich auch wundern, wenn eine Schleife über 40.000 Zeilen schneller wäre als deine Formellösung, bei der man ja die Formel in einem Rutsch im kompletten Bereich eintragen kann.
Warten wir mal auf den Code der in Benutzung ist.
Gruß Werner
AW: Das wundert mich sehr
25.11.2017 01:24:09
Kisska
Hallo Daniel,
zu deinen Fragen:
- ca.500 Spalten
- über 100.000 Zeilen
- es gibt keine Formeln in der Datei
- Daten sollen reduziert werden: a) Zeilen => mehrere Kriterien für zwei Spalten und b) Spaltenüberschriften => mehrere Kriterien
Anbei der Code: 

Sub Reduzierung()
If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Makro aus der zu der bearbeitenden Datei starten"
Exit Sub
End If
' 10 Kriterien in Spalte B bleiben, andere 5 Kriterien werden gelöscht, max. Zeichenlänge = 7
Dim loLetzte As Long, i As Long
Application.ScreenUpdating = False
With ActiveSheet
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = loLetzte To 2 Step -1
Select Case .Cells(i, 2).Value
Case "AO", "U", "DA", "DJ", "F", "GAB", "WW", "Z", "JK", "KY"
Case Else
Rows(i).Delete
End Select
Next i
End With
Application.ScreenUpdating = True
' 18 Kriterien in Spalte T bleiben, andere 25 Kriterien werden gelöscht, max. Zeichenlänge = 20
Dim lz As Long, j As Long
Application.ScreenUpdating = False
With ActiveSheet
lz = .Cells(.Rows.Count, 20).End(xlUp).Row
For j = lz To 2 Step -1
Select Case .Cells(j, 20).Value
Case "11111X", "22 222Y", "3 3X", "XXXXY", "AAAA 3", "22 AA BB", "A()1_XXXX1", "A+B  _
111111_X", "YX1", "WS 56", "XX 11 YYYYY", "XX 22222-66-8", "(1)  1111 – AA- (2)2", "2222", "22 22 YX(1)", "3333X", "XX 2-2 Y", "000_X"
Case Else
Rows(j).Delete
End Select
Next j
End With
Application.ScreenUpdating = True
' 50 Spaltenüberschriften bleiben, andere 450 Spalten werden gelöscht, max. Zeichenlänge der Ü _
berschriften = 20
Dim SpZ As Long
Dim TABELLENNAME As String
Application.ScreenUpdating = False
SpZ = Cells(1, Columns.Count).End(xlToLeft).Column
For SpZ = SpZ To 1 Step -1
TABELLENNAME = Cells(1, SpZ)
If TABELLENNAME  "Überschrift – [1]" And TABELLENNAME  " Überschrift – [2]" And  _
TABELLENNAME  " Überschrift – [3]" And TABELLENNAME  " Überschrift – [4]" And TABELLENNAME  " Überschrift – [5]" And TABELLENNAME  " Überschrift – [6]" And TABELLENNAME  " Überschrift – [7]" And TABELLENNAME  " Überschrift – [8]" And TABELLENNAME  " Überschrift – [9]" And TABELLENNAME  " Überschrift – [10]" And TABELLENNAME  " Überschrift – [11]" And TABELLENNAME  " Überschrift – [12]" And TABELLENNAME  " Überschrift – [13]" And TABELLENNAME  " Überschrift – [14]" And TABELLENNAME  " Überschrift – [15]" And TABELLENNAME  " Überschrift – [16]" And TABELLENNAME  " Überschrift – [17]" And TABELLENNAME  " Überschrift – [18]" And TABELLENNAME  " Überschrift – [19]" And TABELLENNAME  " Überschrift – [20]" And TABELLENNAME  " Überschrift – [21]" And TABELLENNAME  " Überschrift – [22]" And TABELLENNAME  " Überschrift – [23]" And TABELLENNAME  " Überschrift – [24]" And TABELLENNAME  " Überschrift – [25]" And TABELLENNAME  " Überschrift – [26]" And TABELLENNAME  " Überschrift – [27]" And TABELLENNAME  " Überschrift – [28]" And TABELLENNAME  " Überschrift – [29]" And TABELLENNAME  " Überschrift – [30]" And TABELLENNAME  " Überschrift – [31]" And TABELLENNAME  " Überschrift – [32]" And TABELLENNAME  " Überschrift – [33]" And TABELLENNAME  " Überschrift – [34]" And TABELLENNAME  " Überschrift – [35]" And TABELLENNAME  " Überschrift – [36]" And TABELLENNAME  " Überschrift – [37]" And TABELLENNAME  " Überschrift – [38]" And TABELLENNAME  " Überschrift – [39]" And TABELLENNAME  " Überschrift – [40]" And TABELLENNAME  " Überschrift – [41]" And TABELLENNAME  " Überschrift – [42]" And TABELLENNAME  " Überschrift – [43]" And TABELLENNAME  " Überschrift – [44]" And TABELLENNAME  " Überschrift – [45]" And TABELLENNAME  " Überschrift – [46]" And TABELLENNAME  " Überschrift – [47]" And TABELLENNAME  " Überschrift – [48]" And TABELLENNAME  " Überschrift – [49]" And TABELLENNAME  " Überschrift – [50]" Then
Columns(SpZ).Delete
End If
Next SpZ
Application.ScreenUpdating = True
' Alle Daten als Tabelle formatieren
ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Table1"
' Überschriften ergänzen
Range("AE1") = " Überschrift – [51]"
Range("AF1") = " Überschrift – [52]"
' Gruppe (als Wert) eintragen
Range("Table1[Gruppe]").Formula = "A.10"
' Jahr (als Wert) eintragen
Range("Table1[Jahr]").Formula = "2015"
Application.ScreenUpdating = True
End Sub
Den Code wollte ich eigentlich noch zusätzlich um diese zwei Operationen ergänzen: 

Sub Zusatz()
' Spalte durch 1000 teilen
Application.ScreenUpdating = False
Range("Table1[Überschrift – [50]]").Select
Dim zelle As Range
For Each zelle In Selection
zelle.Value = zelle.Value / 1000
Next
' Erstelldatum der geöffneten Datei
Range("Table1[Überschrift – [49]]").Formula = CreateObject("Scripting.FileSystemObject"). _
GetFile(ThisWorkbook.FullName).DateCreated
Application.ScreenUpdating = True
End Sub
.. aber da bekomme ich leider eine Fehlermeldung, dass kein Speicher da ist. Mein Code ist wohl jetzt schon zu lang.
Ich hoffe, es ist alles verständlich ?
Anzeige
AW: Das wundert mich sehr
25.11.2017 15:48:22
Werner
Hallo Kisska,
den Codevorschlag von Gerd hast du wohl nicht getestet?
Dann nochmal.
Das ist der Code von Gerd, jetzt mal nur der erste Teil mit den Texten die erhalten bleiben sollen.
Läuft bei mir mit 100.000 Zeilen und 500 Spalten in etwa 23 Sekunden durch.
Teste doch mal. 
Sub Makro1()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(IsNumber(Find(""|""&RC2&""|"",""|AO|U|DA|DJ|F|GAB|WW|Z|JK|KY|"")),Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige
noch ein Versuch
26.11.2017 18:15:48
Kisska
Hallo Werner, hallo Daniel,
ich möchte Daniels Code nochmal probieren, habe aber noch diese 3 Fragen:
1) Anfang des Codes:
Bei Daniel stand 

With ActiveSheet.Cells(1, 1).CurrentRegion

Bei Werner (siehe vorheriger Post): 

With ActiveSheet.UsedRange
Was ist der Unterschied?
2) Wo im Code gebe ich die Spalte T, also Spalte Nr. 20, an?
3) Suche nach Spaltenüberschriften und dann Löschung der Spalten:
Ist mein verwendeter Code ok oder gibt es einen besseren bzw. schnelleren Code (bspw. Daniels Code aus dem Beitrag "Makro auf andere Dateien anwenden") ?
VG
Kisska
Anzeige
AW: noch ein Versuch
26.11.2017 19:45:58
Werner
Hallo Kisska,
CurrentRegion ist ausgehend von Zelle A1 (Cells(1, 1) der Zellbereich, der komplett von Leerzellen umschlossen ist.
Bei einem lückenlosen Bereich ist CurrentRegion sicherer als UsedRange. Bei UsedRange wird der Bereich erst dann sicher aktualisiert, wenn Excel gespeichert wurde. Es kann dir also passieren, dass die UsedRange erweitert wird, wenn du in einer Zelle einen Wert einträgst und diesen dann wieder löschst. Diese Zelle war ja belegt und wird dann in die UsedRange mit aufgenommen.
Besser wenn du CurrentRegion benutzt.
Den Code habe ich auf Spalte T (20) angepasst. 
Sub Löschen_Mit_REMOVEDUPLICATES()
With ActiveSheet.Cells(1, 1).CurrentRegion
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = _
"=IF(IsNumber(Find(""|""&RC20&""|"",""|Text1|Text2|Text3|Text4|"")),Row(),0)"
.Cells(1, 20).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
End Sub
Teste jetzt erst einmal das hier, dann sehen wir mit den Spalten weiter.
Ich habe hierzu aber noch eine Frage:
Du lässt in einem ersten Schritt eine Schleife über die Spalte B laufen.
Die Schleife löscht alle Zeilen in denen in Spalte B folgende Werte nicht enthalten sind:
|Text1|Text2|Text3|Text4|
Im zweiten Schritt lässt du eine Schleife über Spalte T laufen.
Die Schleife löscht alle Zeilen in denen in Spalte T folgende Werte nicht enthalten sind:
"11111X", "22 222Y", "3 3X", "XXXXY", "AAAA 3", "22 AA BB", "A()1_XXXX1".......
Dir ist dabei aber schon klar, dass deine erste Schleife -nur mal als Beispiel- die Zeile 3 löscht wenn in Spalte B Text1 bis Text3 nicht enthalten ist, obwoh u.U. in Spalte T "11111X" steht?
Gruß Werner
Anzeige
AW: noch ein Versuch
26.11.2017 20:25:59
Kisska
Hallo Werner,
danke für die prompte Antwort und die ausführliche Erklärung!
Juhu, jetzt klappt es mit der Spalte T :-)
Wird also die Spaltennummer (Nr) über RC(Nr) und .Cells(1, Nr).Value = 0 festgelegt?
Warum hat dann Daniel für die Spalte B die 1 geschrieben: .Cells(1, 1).Value = 0 ? Oder muss da eine 2 hin? Interessanterweise wurde der Code auch mit 1 korrekt ausgeführt - verwirrend.
Danke für die Nachfrage! Es ist korrekt, dass durch die Löschung über Spalte B auch die Zeilen verschwinden, von denen das Suchwort in Spalte T vorkommt. Es wird quasi die Schnittmenge behalten.
VG
Kisska
Anzeige
AW: noch ein Versuch
26.11.2017 20:58:24
Werner
Hallo Kisska,
mein Fehler, das muss weiterhin 
.Cells(1, 1).Value = 0
Weil sich das auf die temporär eingefügte Hilfsspalte 
With .Columns(.Columns.Count + 1)
bezieht. Das ist dann in der Hilfsspalte die erste Zelle.
Gruß Werner
Anzeige
ok ... Lösung für Spalten?
26.11.2017 21:36:13
Kisska
Ah, alles klar!
Danke Werner :-)
Ich habe nun die Zeit zur Löschung der Daten nach den zwei Spalten gestoppt: 40 Sekunden - eine super Zeit! An dieser Stelle besten Dank an dich Werner und Daniel!
Nun bleibt die Frage offen, ob mein gewählter Code für Löschung der Spalten optimal ist?
VG
Kisska
Anzeige
AW: ok ... Lösung für Spalten?
27.11.2017 10:51:16
Daniel
Hi
das würde ich so machen:
1. liste die 50 Spaltenüberschriften, die erhalten bleiben müssen, in einem weitern Tabellenblatt in einer freien Spalte (z. B. Tabelle2!A:A) untereinander auf.
in einem Tabellenblatt hast du bei 50 verschiedenen Texten eine besser übersicht, als wenn du das im Code verdatest
2. um die Spalten zu identifizieren, verwendest du in der letzten Zeile eine Formel in dieser Art in der ersten freien Zeile unterhalb der Tabelle und löschst dann alle Spalten mit Fehler.
sieht dann in etwas so aus: 
With ActiveSheet.Usedrange
With .Rows(.Rows.Count + 1)
.FormulaR1C1 = "=Match(R1C,Tabelle2!C1,0)"
.SpecialCells(xlcelltypeformulas, 16).EntireColumn.Delete
.ClearContents
end with
end with
probier auch mal, obs was bringt, wenn du erst die Spalten löschst und danach die Zeilen.
Gruß Daniel
Anzeige
AW: ok ... Lösung für Spalten?
27.11.2017 11:20:19
Werner
Hallo Kisska,
von Daniel ist ja schon ein Lösungsvorschlag gekommen. Da ich auch schon was habe, jetzt noch meine Version. Kannst ja testen welche für deine Verhältnisse besser läuft.
Ich kopiere zunächst die 50 Spalten die übrig bleiben sollen rechts neben die bestehende Tabelle und Lösche im Anschluß den gesamten Rest.
Das sind dann 50 Kopiervorgänge und ein Löschvorgang. Also auf alle Fälle deutlich schneller als wenn du mit einer Schleife über 500 Spalten läufst und von den 500 Spalten 450 gelöscht werden. Das wären dann 450 einzelne Löschvorgänge. 
Dim i As Long, j As Long
SpZ = Cells(1, Columns.Count).End(xlToLeft).Column
j = SpZ + 2
Application.ScreenUpdating = False
For i = 1 To SpZ
Select Case Cells(1, i).Value
Case "Überschrift – [1]", "Überschrift – [2]", "Überschrift – [3]", "Überschrift – [4]" _
, "Überschrift – [5]", "Überschrift – [6]", "Überschrift – [7]", "Überschrift – [8]" _
, "Überschrift – [9]", "Überschrift – [10]", "Überschrift – [11]", "Überschrift – [12]" _
, "Überschrift – [13]", "Überschrift – [14]", "Überschrift – [15]", "Überschrift – [16]" _
, "Überschrift – [17]", "Überschrift – [18]", "Überschrift – [19]", "Überschrift – [20]" _
, "Überschrift – [21]", "Überschrift – [22]", "Überschrift – [23]", "Überschrift – [24]" _
, "Überschrift – [25]", "Überschrift – [26]", "Überschrift – [27]", "Überschrift – [28]" _
, "Überschrift – [29]", "Überschrift – [30]", "Überschrift – [31]", "Überschrift – [32]" _
, "Überschrift – [33]", "Überschrift – [34]", "Überschrift – [35]", "Überschrift – [36]" _
, "Überschrift – [37]", "Überschrift – [38]", "Überschrift – [39]", "Überschrift – [40]" _
, "Überschrift – [41]", "Überschrift – [42]", "Überschrift – [43]", "Überschrift – [44]" _
, "Überschrift – [45]", "Überschrift – [46]", "Überschrift – [47]", "Überschrift – [48]" _
, "Überschrift – [49]", "Überschrift – [50]"
Columns(i).Copy Columns(j)
j = j + 1
Case Else
End Select
Next i
Range(Columns(1), Columns(SpZ + 1)).Delete
Application.ScreenUpdating = True

Gruß Werner
Anzeige
Absolut geniale Lösungen!
27.11.2017 19:10:23
Kisska
Hallo Werner, hallo Daniel,
ihr seid spitze! Beide Coes funktionieren tadellos! Geniale Logik - darauf muss einer erst mal kommen :-)
Herzlich Dank an euch beide !!!
Von der Zeit her habe ich mit Werners Code 10 Sek gebraucht und mit Daniels Code nur 5 Sek. Ich tendiere dennoch die Variante von Werner zu nehmen, weil ich recht viele Daten-Dateien auf diese Art bereinigen muss. Manuell ein weiteres Tabellenblatt mit den Überschriften hinzuzufügen würde daher etwas mehr Aufwand bedeuten, es sei denn man lässt das Tabellenblatt mit VBA hinzufügen. Ich fände es interessant zu erfahren, wie man das hinbekommt?
Den Anfang des Codes so?: 

Sheets.Add(before:=ActiveSheet).Name = "Ueberschriften"
ActiveCell.FormulaR1C1 = "ÜB1"
ActiveCell.FormulaR1C1 = "ÜB2"
ActiveCell.FormulaR1C1 = "ÜB3"
ActiveCell.FormulaR1C1 = "ÜB4"
ActiveCell.FormulaR1C1 = "ÜB5"
ActiveCell.FormulaR1C1 = "ÜB6"

Wenn ich dann Daniels Code ergänze: 

With ActiveSheet.Usedrange
With .Rows(.Rows.Count + 1)
.FormulaR1C1 = "=Match(R1C,Ueberschriften!C1,0)"
.SpecialCells(xlcelltypeformulas, 16).EntireColumn.Delete
.ClearContents
end with
end with

Dann kommt Unsinn raus :)
VG
Kisska
Anzeige
AW: Absolut geniale Lösungen!
27.11.2017 22:30:45
Daniel
Hi
Ich würde die Spaltentitel von Hand ins Tabellenblatt schreiben, in der Datei in der auch das Makro liegt.
Die verschwinden ja nicht, sondern werden mit gespeichert.
Wenn man eine andere Datei bearbeiten will, muss man in der Formel den Zellbezug um den Dateinamen der Datei mit dem Makro und der Überschriftenliste erweitern.

....FormulaR1C1 = "=Match(R1C,'[" & Thisworkbook.name & "]Überschriften'!C1,0)"
Gruß Daniel
Anzeige
Code ist von Daniel und nicht von Gerd. o.w.T.
25.11.2017 15:49:36
Daniel
AW: Autofilter?
25.11.2017 16:02:36
Fennek
Hallo,
ich habe die Datei und die Codes der Antworter nur überflogen, aber stellte sich die Frage, warum nicht etwas einfacher mit dem Autofilter, auch per VBA?
Der Code würde stark gekürzt und übersichtlicher.
mfg
ein Beispiel?
26.11.2017 18:32:22
Kisska
Hallo Fennek,
könntest du bitte deinen Code posten?
VG
Kisska
Anzeige
AW: VBA erweitern: Zeilen löschen schnell
21.11.2017 21:27:45
Daniel
Hi
Zeilen löschen mit Bedingung geht am einfachsten und schnellsten, wenn man die zu löschenden Zeilen in einer Hilfsspalte per Formel mit 0 kennzeichnet und die Zeilen die die stehen bleiben müssen, mit der Zeilennummer.
Dann kann man die so gekennzeichneten Zeilen mit dem Duplikate-Entfernen löschen.
Für deine 4 Texte beispielsweise so:
With ActiveSheet.Usedrange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(IsNumber(Find(""|""&RC2&""|"",""|Text1|Text2|Text3|Text4|"")),Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .column, xlno
.ClearContents
End with
End with
Diesen Code solltest du dir merken, weil du ihn eigentlich für alle Aufgaben zum Thema "Zeilenlöschen mit Bedingung" verwenden kannst, du musst lediglich die Formel an die Bedingungen anpassen.
Gruß Daniel
Anzeige
AW: VBA erweitern: Zeilen löschen schnell
21.11.2017 23:07:49
Kisska
Interessanter Ansatz, Daniel! Danke!
Als VBA-Anfängerin hätte ich ein Makro aufgezeichnet mit der Hilfsspalte, wie von dir beschrieben, dann wäre aber die Hilfsspalte geblieben. Wodurch lässt du die Hilfsspalte in deinem Code verschwinden?
VG
Kisska
VBA basiert auf der englischen Sprache...
21.11.2017 23:19:13
Daniel
... welcher Befehl könnte denn danach aussehen, dass er was mit "Inhalte löschen" zu tun hat?
ansonsten, starte den Recorder, markiere ein paar Zellen mit Inhalt und drücke die Entfernen-Taste.
Dann schau dir den aufgezeichneten Code an. Du solltest den Befehl wiederfinden.
Gruß Daniel
Anzeige
Danke an alle und kurze Frage
22.11.2017 00:09:44
Kisska
Danke an alle Helfer, ihr habt mir super weitergeholfen!
Beide Lösungen - von Werner und Daniel funktionieren einwandfrei.
Auch wenn die Lösung schon steht, interessiert mich noch folgende Lösung:
In einem anderen Beitrag von mir ging es um das Löschen der Spalten mit dem folgenden Code:
Sub SpaltenEntfernen()
Dim spaltenzaehler As Integer
Dim Name As String
Application.ScreenUpdating = False
spaltenzaehler = 1
While Cells(1, spaltenzaehler)  ""
Name = Cells(1, spaltenzaehler)
If Name  "Text1" And Name  "Text2" And Name  "Text3" And Name  "Text4" Then
Columns(spaltenzaehler).Delete
spaltenzaehler = spaltenzaehler - 1
End If
spaltenzaehler = spaltenzaehler + 1
Wend
Application.ScreenUpdating = True
End Sub
Diesen Code habe ich versucht, auf die Zeilen anzuwenden: 

Sub ZeilenEntfernen()
Dim zeilenzaehler As Integer
Dim Name As String
Application.ScreenUpdating = False
zeilenzaehler = 2
While Cells(zeilenzaehler, 2)  ""
Name = Cells(zeilenzaehler, 2)
If Name  "1" And Name  "2" And Name  "3" And Name  "4" Then
Rows(zeilenzaehler).Delete
zeilenzaehler = zeilenzaehler - 1
End If
zeilenzaehler = zeilenzaehler + 1
Wend
Application.ScreenUpdating = True
End Sub
Der Code funktioniert bei zu vielen Daten nicht, es kommt zum Fehler "Überlauf". Wieso entsteht dieser Fehler?
Anzeige
AW: kurze Antwort
22.11.2017 07:04:43
Gerd
Hallo Kisska,
die (Gesamt-)Zeilenanzahl ist größer als die Obergrenze des Variablentyps Integer.
Verwende Long.
Gruß Gerd
perfekt!
22.11.2017 11:38:44
Kisska
Danke Gerd!
Gerne u. Danke für die Rückmeldung
22.11.2017 11:19:31
Werner
Hallo Kisska,
und für deine Frage hast du ja eine Antowrt erhalten. Zeilen/Spalten Variablen sollte man besser immer als Long deklarieren.
Gruß Werner
Anzeige
werde ich mir merken :-)
22.11.2017 11:40:13
Kisska
Danke Werner!
VG
Kisska

Forumthreads zu verwandten Themen

Nur gefilterte Zeilen in ein Textfeld übergeben
Heiko

Hallo an alle,
ich brauche ein wenig Hilfe. Ich bin gerade dabei aus einem ziemlich breiten (unübersichtlich geworden) Sheet die gewünschten Werte in eine Form (Textfeld) zu übergeben.
Ich bekomme es leider nicht hin, dass nur die gefilterten Zeilen im Textfeld erscheinen sollen.
Ic...
05.11.2008 19:59:37
Thread-ID: 1022076
7 Beiträge
Alle Zeilen löschen mit Spaltenbedingung ?
alexander

Hallo,
wie ist es möglich das mir ein Makro alle Zeilen löscht wo in Spalte G nichts steht. Das Makro sollte in Zeile 5 beginnen zu laufen.
Danke,
Alex
16.09.2009 10:37:32
Thread-ID: 1103140
7 Beiträge
einfügen von daten in gefilterte Liste
daten

hallo zusammen
ich habe folgendes problem:
ich habe eine gesamtliste, ( mit den Spalten,Kundennr, Kundenname Ansprechpartner im Aussendienst (der gehört zu meiner Firma und betruet den Kunden in dieser Zeile) , briefversand j oder n ) . Diese Liste schicke ich an bspw. an 10 Mitarbeite...
11.02.2010 21:06:51
Thread-ID: 1137726
2 Beiträge
Filter nicht möglich
otto

Hi,
warum kann anhängende Tabelle nicht richtig gefiltert werden ?
Ich habe die Zellen schon als Datum formatiert, es werden aber nur die Einträge bis zum 13.05.08 angezeigt.
https://www.herber.de/bbs/user/69835.zip
Gruß
otto
01.06.2010 10:27:19
Thread-ID: 1159749
2 Beiträge
Ausgeblendete Zellen Löschen
Marta

Hallo ,
habe da ein kleines Makro Problem. Und zwar wende ich den Spezialfilter an, u lasse mir alle Duplikate ausblenden, nun möchte ich bei den ausgeblendeten Zeilen (nur in Spalte U) den Inhalt löschen.
Sub ausgeblendeteLöschen() Dim Letzte As Long Dim I As Long lastRowU = Range("U"...
07.06.2010 11:36:51
Thread-ID: 1160632
7 Beiträge
Anzeige
VBA schreiben zum Zeilen löschen
Ludwig

Hallo,
vielleicht weis einer was ich hier schreiben müsste?
siehe Anhang
https://www.herber.de/bbs/user/72108.xls
Danke im voraus
lg Ludwig
31.10.2010 18:51:40
Thread-ID: 1184622
7 Beiträge
VBA - zeilen aus liste löschen
susanne

Hallo,
ich bin nicht sonderlich fit in VBA und habe ein kleines problem.
Ich lasse aus einem arbeitsblatt zuerst die daten in ein weiteres blatt kopieren, dann sollen die zeilen gelöscht werden, in denen in der spalte 4 nichts (0) drinsteht. Das funktioniert mit dem skript unten auch. j...
11.11.2010 15:33:12
Thread-ID: 1186332
3 Beiträge
VBA Zeilen löschen beschleunigen
Frank

Hallo zusammen,
ich benutze folgenden Code, um Zeilen zu löschen, in deren Spalte "B" ein Wert steht, der in einer zuvor definierten Range auftaucht:
Sub cust_del() Application.ScreenUpdating = False Dim i As Integer Dim lz As Integer Worksheets("ergebnis").Activate lz = Range("A4").End...
29.03.2011 11:11:55
Thread-ID: 1208031
4 Beiträge
VBA: Zeilen mit Eintrag in Spalte B löschen
Martin

Guten Tag
Wie kann ich vermeiden beim untenstehende Code ein RC22 (hätte lieber ein Range oder Cells) einzugeben. Ich möchte, dass alle Zeilen mit Eintrag O oder P in Spalte B gelöscht werden.
Besten Dank im voraus.
Martin
'O und P löschen
With xxx.UsedRange
With .Colum...
13.04.2011 15:29:24
Thread-ID: 1210256
7 Beiträge
ausgeblendete Zeilen (Inhalt) löschen
Lorenz

Hallo Excelscheff`s
Für mich wieder mal ein ungelöstes Langzeitproblem.
Mit folgenden Codezeilen wird der Inhalt von ausgeblendeten (Filter-Rest) Zeilen nicht gelöscht.
Wie muß der Code lauten um die "ausgeblendeten Zeilen in den Löschvorgang ein zu beziehen?
LoLetzte = wksDaten...
16.05.2011 13:28:15
Thread-ID: 1214665
3 Beiträge
Alle Leere Zeilen In A Spalte Löschen
Leo

Abend zusammen,
ich hab folgendes Problem !?
Ich habe in der A SPALTE eine Namensliste, mit mehreren tausend Namen, doch leider sind mir beim kopieren in Excel ein paar "ZEILEN Lücken" - ich hoffe ihr versteht mein Problem, kann es nicht besser formulieren - aufgestoßen ...
Meine Fr...
28.09.2011 21:43:27
Thread-ID: 1231905
4 Beiträge
Anzeige
VBA: leere Zeilen löschen
Fritz_W

Hallo Forumsbesucher,
ich bitte um Eure Hilfe:
Mit welchem Code lassen sich alle leere Zeilen der aktiven Spalte (bis zur letzten Zeile mit Inhalt) löschen.
Beispiel: Befindet sich der Cursor in Zelle C6 und ist in Spalte C die letzte Zelle mit Inhalt die Zelle C957 sollten alle lee...
19.10.2011 09:27:12
Thread-ID: 1234458
3 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige