Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA erweitern: Zeilen löschen


Betrifft: VBA erweitern: Zeilen löschen von: Kisska
Geschrieben am: 21.11.2017 14:31:36

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

  

Betrifft: AW: VBA erweitern: Zeilen löschen von: Ulf
Geschrieben am: 21.11.2017 15:09:57

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


  

Betrifft: das wird so nichts von: Werner
Geschrieben am: 21.11.2017 16:23:23

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


  

Betrifft: AW: VBA erweitern: Zeilen löschen von: Werner
Geschrieben am: 21.11.2017 16:16:40

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


  

Betrifft: 'Select Case' wäre eine brauchbarere Wahl, ... von: Luc:-?
Geschrieben am: 21.11.2017 19:52:34

…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 …


  

Betrifft: AW: VBA erweitern: Zeilen löschen von: Kisska
Geschrieben am: 21.11.2017 20:41:43

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


  

Betrifft: AW: VBA erweitern: Zeilen löschen von: Uduuh
Geschrieben am: 21.11.2017 20:56:41

Hallo,
dann ersetze Worksheets("Tabelle1") durch ActiveSheet

Gruß aus’m Pott
Udo



  

Betrifft: klasse, danke! von: Kisska
Geschrieben am: 21.11.2017 23:01:43

Danke Udo!


  

Betrifft: noch eine kleine Frage von: Kisska
Geschrieben am: 22.11.2017 13:23:46

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


  

Betrifft: Beispielmappe von: Werner
Geschrieben am: 22.11.2017 15:03:07

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


  

Betrifft: AW: Beispielmappe von: Kisska
Geschrieben am: 22.11.2017 18:36:22

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


  

Betrifft: AW: Beispielmappe von: Daniel
Geschrieben am: 22.11.2017 23:18:38

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


  

Betrifft: die Methode dauert leider länger von: Kisska
Geschrieben am: 22.11.2017 23:30:16

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 :)


  

Betrifft: Das wundert mich sehr von: Daniel
Geschrieben am: 23.11.2017 00:45:58

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


  

Betrifft: mich auch von: Werner
Geschrieben am: 23.11.2017 10:06:20

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


  

Betrifft: AW: Das wundert mich sehr von: Kisska
Geschrieben am: 25.11.2017 01:24:09

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 ?


  

Betrifft: AW: Das wundert mich sehr von: Werner
Geschrieben am: 25.11.2017 15:48:22

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


  

Betrifft: noch ein Versuch von: Kisska
Geschrieben am: 26.11.2017 18:15:48

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


  

Betrifft: AW: noch ein Versuch von: Werner
Geschrieben am: 26.11.2017 19:45:58

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


  

Betrifft: AW: noch ein Versuch von: Kisska
Geschrieben am: 26.11.2017 20:25:59

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


  

Betrifft: AW: noch ein Versuch von: Werner
Geschrieben am: 26.11.2017 20:58:24

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


  

Betrifft: ok ... Lösung für Spalten? von: Kisska
Geschrieben am: 26.11.2017 21:36:13

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


  

Betrifft: AW: ok ... Lösung für Spalten? von: Daniel
Geschrieben am: 27.11.2017 10:51:16

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


  

Betrifft: AW: ok ... Lösung für Spalten? von: Werner
Geschrieben am: 27.11.2017 11:20:19

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


  

Betrifft: Absolut geniale Lösungen! von: Kisska
Geschrieben am: 27.11.2017 19:10:23

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


  

Betrifft: AW: Absolut geniale Lösungen! von: Daniel
Geschrieben am: 27.11.2017 22:30:45

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


  

Betrifft: Code ist von Daniel und nicht von Gerd. o.w.T. von: Werner
Geschrieben am: 25.11.2017 15:49:36




  

Betrifft: AW: Autofilter? von: Fennek
Geschrieben am: 25.11.2017 16:02:36

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


  

Betrifft: ein Beispiel? von: Kisska
Geschrieben am: 26.11.2017 18:32:22

Hallo Fennek,

könntest du bitte deinen Code posten?

VG
Kisska


  

Betrifft: AW: VBA erweitern: Zeilen löschen schnell von: Daniel
Geschrieben am: 21.11.2017 21:27:45

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


  

Betrifft: AW: VBA erweitern: Zeilen löschen schnell von: Kisska
Geschrieben am: 21.11.2017 23:07:49

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


  

Betrifft: VBA basiert auf der englischen Sprache... von: Daniel
Geschrieben am: 21.11.2017 23:19:13

... 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


  

Betrifft: Danke an alle und kurze Frage von: Kisska
Geschrieben am: 22.11.2017 00:09:44

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?


  

Betrifft: AW: kurze Antwort von: Gerd L
Geschrieben am: 22.11.2017 07:04:43

Hallo Kisska,

die (Gesamt-)Zeilenanzahl ist größer als die Obergrenze des Variablentyps Integer.
Verwende Long.

Gruß Gerd


  

Betrifft: perfekt! von: Kisska
Geschrieben am: 22.11.2017 11:38:44

Danke Gerd!


  

Betrifft: Gerne u. Danke für die Rückmeldung von: Werner
Geschrieben am: 22.11.2017 11:19:31

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


  

Betrifft: werde ich mir merken :-) von: Kisska
Geschrieben am: 22.11.2017 11:40:13

Danke Werner!

VG
Kisska


Beiträge aus den Excel-Beispielen zum Thema "VBA erweitern: Zeilen löschen"