Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro soll Zeilen nach mehreren bedinungen löschen

Makro soll Zeilen nach mehreren bedinungen löschen
Thorsten
Hallo zusammen,
ich suche jetzt schon ne Weile, aber mein VBA reicht einfach nicht aus um die Lösungen so zusammen zu basteln dass es passt.
Folgendes Problem:
Ich habe eine Datentabelle mit ca. 8000 Zeilen. Diese möchte ich bereinigen, d.h. ich muss Zeilen löschen die in 4 verschiedenen Spalten bestimmte VERSCHIEDENE Werte haben, oder eben NICHT haben.
Beispiel:
In Spalte F alles löschen was NICHT "20" ist
In Spalte H alles löschen was NICHT "S" ist
In Spalte I alles löschen was NICHT "Y" ist
In Spalte BW alles lösche was "A" oder "B" ist
(jeweils die ganze Zeile löschen wenn ein Punkt zutrifft)
Die ersten 6 Zeilen aus der Datei enthalten u.a. die Überschriften, die ich stehen lassen möchte.
Um es möglichst schnell zu gestalten wäre ein Makro von Vorteil, was das Ende der Tabelle sucht und dort rückwärts anfängt zu löschen.
Noch eins - ich möchte das Makro von einer anderen Datei aus starten (nennen wir sie "Auswertung.xls", die diese Datei auswertet (nennen wir sie "Quelle.xls")
Manuell gehe ich im Moment so vor, dass ich einen Autofilter setze und nacheinander die Zeilen wie im Beispiel angegeben filtere und dann lösche. Das mache ich mindestens einmal am Tag.
Für euch sicher eine leichte Übung. Wie gesagt - es gibt viele ähnliche Lösungen.
Vielen Dank schonmal im Voraus!
Gruss
Thorsten
AW: Makro soll Zeilen nach mehreren bedinungen löschen
18.11.2010 14:21:43
Tino
Hallo,
eine Gegenfrage dazu, sind dies UND oder ODER Bedingungen.
Beispiel, welche Zeilen sollen gelöscht werden
 FGHIBW
1ÜberschriftÜberschriftÜberschriftÜberschriftÜberschrift
220 SYA
320 SYB
421    
5  S  
6   Y 
7  S  
8   Y 
9  S  
10    B
11    C
12    D
13    E
14   X 
15   X 
16   Z 

Alle auser Zeile 2 und 3, weil alle Bedingungen erfüllt sind?
Oder Zeile 4,11,12,13,14,15 u. 16, weil nicht eine Bedingung erfüllt ist?
Gruß Tino
Anzeige
AW: Makro soll Zeilen nach mehreren bedinungen löschen
18.11.2010 14:29:39
Thorsten
Hi,
so würden bei mir ALLE gelöscht, weil in BW noch "A" und "B" stehen. Vielleicht sage ich mal was übrig bleiben soll. Folgendes darf übrig bleiben:
Spalte F: nur "20"
Spalte H: nur "S"
Spalte I: nur "Y"
Spalte BW: alles AUSSER "A" oder "B"
Ist also bei F-I eine Zelle NICHT 20/S/Y, dann darf sie nicht auftauchen genauso wie in BW kein Eintrag mit A oder B übrig bleiben darf.
Ist das irgendwie klar geworden?
kannst mal testen
18.11.2010 14:41:17
Tino
Hallo,
versuch mal diesen Code.
Dateiname und Tabelle noch anpassen.
Die Datei muss in dieser Instanz geöffnet sein, sonst muss dies noch eingebaut werden.
Sub Loeschen_Zeilen()
Dim oSH As Worksheet, iCalc As Integer

'Datei und Tabelle anpassen, diese muss in der Instanz offen sein 
Set oSH = Workbooks("Quelle.xls").Sheets("Tabelle1")

With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
     With oSH.UsedRange
        'Tabelle hat keine Überschrift, dann .Offset(0, 1) 
        With .Columns(.Columns.Count).Offset(1, 1)
            
            'Formel die True (Bedingung nicht erfüllt) oder die Zeile zurückgibt 
            'Alle Zeilen die Wahr als ergebis liefern werden gelöscht 
            'hier wird die Formel eingesetzt 
            '=WENN(ODER($F2=20;$H2="S";$I2="Y";ODER($BW2="A";$BW2="B"));ZEILE();WAHR) 
            .Formula = "=IF(AND(RC6=20,RC8=""S"",RC9=""Y"",AND(RC75<>""A"",RC75<>""B"")),ROW(),TRUE)"
            
            'sortieren 
            oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
            
            On Error Resume Next
                'löschen 
                .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
                'Hilfsspalte löschen 
                .EntireColumn.Delete
            On Error GoTo 0
            
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With

End Sub
Gruß Tino
Anzeige
TADAAAH!
18.11.2010 15:05:22
Thorsten
Als ich es innerhalb der Datei "Quelle" ausprobiert habe, da gings.
Aber in der andern Datei kam die Meldung
Laufzeitfehler 9:
Index außerhalb des gültigen Bereichs:
für diese Zeile
Set oSH = Workbooks("AMS_aktuell.xls").Sheets("TABELLE01")
Vielleicht weil ich Offset (1,1) auf (6,1) gesetzt habe?
tadah ist nicht ganz richtig ... :(
18.11.2010 15:10:58
Thorsten
nicht dass jemand meint das Problem sei gelöst ...
Hast meine Korrektur gesehen ? (owT)
18.11.2010 15:18:51
Renee

AW: Hast meine Korrektur gesehen ? (owT)
18.11.2010 15:22:00
Thorsten
Ja - und versuche mich gerade daran, aber wie gesagt ich brauche eine Änderung dass ich es von einer anderen Datei aus machen kann.
Das Problem scheint die Funktion Worksheets zu sein ... deswegen geht er in die Meldung "INdex außerhalb des gültigen Bereichs".
Haste dafür auch eine Lösung?
Danke.
Anzeige
Falsche Korrektur ;-)...
18.11.2010 15:25:26
Renee
Ich meine
Sub VielesLöschen()
Dim lngLastRow As Long, lngRow As Long
Application.ScreenUpdating = False
With ActiveSheet
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngRow = lngLastRow To 7 Step -1
If Not (.Cells(lngRow, 6) = 20) Or _
Not (.Cells(lngRow, 8) = "S") Or _
Not (.Cells(lngRow, 9) = "Y") Or _
.Cells(lngRow, 75) = "B" Then
.Rows(lngRow).Delete xlShiftUp
End If
Next lngRow
End With
Application.ScreenUpdating = True
End Sub

das hier. Das funktioniert von irgendeiner Mappe, direkt auf das gerade aktive Tabellenblatt!
GreetZ Renée
Anzeige
erst ab Zeile 7...
18.11.2010 15:25:00
Tino
Hallo,
wenn erst ab Zeile 7 gilt, versuch mal dies.
Sub Loeschen_Zeilen()
Dim oSH As Worksheet, iCalc As Integer

'Datei und Tabelle anpassen, diese muss in der Instanz offen sein 
Set oSH = Workbooks("AMS_aktuell.xls").Sheets("TABELLE01")

With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
     With oSH.UsedRange
        With .Columns(.Columns.Count).Offset(6, 1)
            
            'Formel die True (Bedingung nicht erfüllt) oder die Zeile zurückgibt 
            'Alle Zeilen die Wahr als ergebis liefern werden gelöscht 
            'hier wird die Formel eingesetzt 
            '=WENN(ODER($F2=20;$H2="S";$I2="Y";UND($BW2="A";$BW2="B"));ZEILE();WAHR) 
            .Formula = "=IF(AND(RC6=20,RC8=""S"",RC9=""Y"",AND(RC75<>""A"",RC75<>""B"")),ROW(),TRUE)"
            
            'sortieren 
            .EntireRow.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
            
            On Error Resume Next
                'löschen 
                .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
                'Hilfsspalte löschen 
                .EntireColumn.Delete
            On Error GoTo 0
            
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With

End Sub
Gruß Tino
Anzeige
AW: erst ab Zeile 7...
18.11.2010 15:29:20
Thorsten
Das ist glaube ich nicht das Problem. Ist die Funktion in Excel 2003 vielleicht ne andere als "Workbooks"?
Da ist die STelle wo der Debugger eingreift.
funktioniert nur in der gleichen Datei
18.11.2010 15:53:04
Thorsten
Hi,
jo - prinzipiell funktionierts. Nur versuche mal folgendes:
Kopie erstellen von der Beispieldatei und aus der das Makro starten, während Du AMS_aktuell noch offen hast.
Dann kommt bei mir die Debuggermeldung.
Innerhalb einer Datei funktioniert das alles wunderbar, aber AMS_aktuell ist bei mir ein Auszug aus einem System, bei dem ich nicht immer das Makro reinkopieren möchte, sondern einfach immer in der Auswertedatei das Makro starten.
Anzeige
AW: funktioniert nur in der gleichen Datei
18.11.2010 16:04:53
Thorsten
Müssen die Dateien vielleicht im gleichen Verzeichnis liegen?
bei mir gehts...
18.11.2010 16:17:55
Tino
Hallo,
, hier die Variante.
Öffne Mappe1 die andere wird autom. geöffnet, drücke auf den Button in Mappe1.
https://www.herber.de/bbs/user/72363.zip
Ich denke bei Dir ist die Datei nicht in der selben Instanz.
Gruß Tino
AW: bei mir gehts...
18.11.2010 16:22:16
Thorsten
Danke .. ich habs jetzt glaube ich ... ich habs nämlich mit meiner xls probiert.
DIESE habe ich als xls gespeichert, sie war aber eine xml glaube ich.
Hat jemand da einen Trick? Bei Deinen Dateien gehts einwandfrei.
AW: bei mir gehts...
18.11.2010 16:33:48
Tino
Hallo,
wir könnten die Datei suchen.
Sub Loeschen_Zeilen()
Dim oSH As Worksheet, iCalc As Integer
Dim lngErste&, lngLetzte&
Dim oWB As Workbook

'Datei suchen 
For Each oWB In Workbooks
    If oWB.Name Like "AMS_aktuell.*xl*" Then
        Set oSH = oWB.Sheets("TABELLE01")
        Exit For
    End If
Next

If oSH Is Nothing Then
    MsgBox "Datei 'AMS_aktuell' nicht gefunden!", vbExclamation
    Exit Sub
End If
    
With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
     With oSH
        'ab Zeile 
        lngErste = 7
        'bis Zeile (letzte Zeile im Usedrange) 
        lngLetzte = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Row
        If lngErste > lngLetzte Then Exit Sub 'keine Daten ab Zeile 7 
        
        With .Range(.Cells(lngErste, .Columns.Count), .Cells(lngLetzte, .Columns.Count))
            
            'Formel die True (Bedingung nicht erfüllt) oder die Zeile zurückgibt 
            'Alle Zeilen die Wahr als ergebis liefern werden gelöscht 
            'hier wird die Formel eingesetzt 
            '=WENN(ODER($F2=20;$H2="S";$I2="Y";UND($BW2="A";$BW2="B"));ZEILE();WAHR) 
            .Formula = "=IF(AND(RC6=20,RC8=""S"",RC9=""Y"",AND(RC75<>""A"",RC75<>""B"")),ROW(),TRUE)"
            
            'sortieren 
            .EntireRow.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
            
            On Error Resume Next
                'löschen 
                .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
                'Hilfsspalte löschen 
                .EntireColumn.Delete
            On Error GoTo 0
            
        End With
     End With
 
 .ScreenUpdating = True
 .Calculation = iCalc
End With

End Sub
Gruß Tino
Anzeige
AW: bei mir gehts...
18.11.2010 16:46:19
Thorsten
Das ist noch besser ... aber Dein Script hat vorher schon funktioniert. Bei Renee's Script hab ich die Debuggermeldung allerdings immer noch.
TAUSEND DANK EUCH BEIDEN! :o)
Sind die Bedingungen gleichbleibend? (owT)
18.11.2010 14:24:24
Renee

AW: Sind die Bedingungen gleichbleibend? (owT)
18.11.2010 14:29:23
Thorsten
Ja - die Bedingungen sind immer gleich. Wenn mir dieser Fall abgedeckt wird komme ich klar wenn es Änderungen gibt. :o)
Dann probier's mal:
18.11.2010 14:33:47
Renee
Thorsten,
Sub VielesLöschen()
Dim lngLastRow As Long, lngRow As Long
With ActiveSheet
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp)
For lngRow = lngLastRow To 7 Step -1
If Not (.Cells(lngRow, 6) = 20) Or _
Not (.Cells(lngRow, 8) = "S") Or _
Not (.Cells(lngRow, 9) = "Y") Or _
.Cells(lngRow, 75) = "B" Then
.Rows(lngRow).Delete xlShiftUp
End If
Next lngRow
End With
End Sub
GreetZ Renée
Anzeige
"Typen unverträglich"
18.11.2010 14:43:07
Thorsten
er markiert mir:
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp)
im Debugger als "Typen unverträglich"
ooops ?, da ging was verloren,
18.11.2010 14:50:54
Renee
Holger,
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
GreetZ Renée
AW: ooops ?, da ging was verloren,
18.11.2010 15:56:38
Thorsten
Dieser Code funktioniert bei mir aus einer anderen Datei heraus nicht:
Dim lngLastRow As Long, lngRow As Long
Application.ScreenUpdating = False
With Workbooks("AMS_aktuell.xls").Sheets("TABELLE01")
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngRow = lngLastRow To 7 Step -1
If Not (.Cells(lngRow, 6) = 20) Or _
Not (.Cells(lngRow, 8) = "S") Or _
Not (.Cells(lngRow, 9) = "Y") Or _
.Cells(lngRow, 75) = "B" Then
.Rows(lngRow).Delete xlShiftUp
End If
Next lngRow
End With
Application.ScreenUpdating = True
Anzeige
Mein Code sieht anders aus!!! (owT)
18.11.2010 16:24:26
Renee

Danke! ich fass es nicht ..
18.11.2010 16:32:22
Thorsten
Also - als Feedback. Ich hab die Datei die ich aus der Datenbank exportiert habe nach dem Speichern offen gelassen. Das war anscheinend das ganze Problem.
Nach schliessen und wieder öffnen alles kein Thema ... allerdings geht das Makro von Tino wesentlich schneller durch als das von Renee ... hätte ich aufgrund des Quellcodes nicht erwartet.
Danke euch beiden!
Gruss
Thorsten

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige