alle daten löschen mit P

Hallo zusammen,
ich habe folgende liste in der Spalte A
SpalteA...........SpalteB
8-44-89-7P......8-44-89-71
8-44-89-7P......8-44-89-72
8-44-89-7P......8-44-89-73
leerzelle..........ein Text
7-98-98-55......7-98-98-51
7-98-98-55......7-98-98-52
Leerzelle..........ein Text
8-88-88-47......8-88-88-48
Leerzelle..........ein Text
4-44-39-7P......4-44-39-71
4-44-39-7P......4-44-39-72
Ich möchte gerne per VBA, dass er alle Daten löscht mit Leerzelle in Spalte A und Daten ohne P.
So wäre es dann richtig:
SpalteA...........SpalteB
8-44-89-7P......8-44-89-71
8-44-89-7P......8-44-89-72
8-44-89-7P......8-44-89-73
4-44-39-7P......4-44-39-71
4-44-39-7P......4-44-39-72
Spalte C sind auch noch Daten vorhanden. Ab Spalte D ist nichts mehr drin.
Wäre sowas möglich?
Danke an alle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro3() ' Makro3 Makro Range("D1").Select ActiveCell.FormulaR1C1 = "Hilf" Range("D2").Select ActiveCell.FormulaR1C1 = "=RIGHT(RC[-3])=""P""" Range("D2").Select Selection.AutoFill Destination:=Range("D2:D11"), Type:=xlFillDefault Range("D2:D11").Select Selection.AutoFill Destination:=Range("D2:D40708"), Type:=xlFillDefault Range("D2:D40708").Select Range("A1:D1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$D$39570").AutoFilter Field:=4, Criteria1:="WAHR" Sheets.Add After:=Sheets(Sheets.Count) Sheets("WH25").Select Columns("A:D").Select Selection.Copy Sheets("Tabelle3").Select Columns("A:A").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("D:D").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft End Sub

Sub Makro3() Dim LR As Double With Sheets("WH25") LR = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte .Range("D1") = "Hilf" .Range("D2:D" & LR).FormulaR1C1 = "=RIGHT(RC[-3])=""P""" .Range("$D$1:$D$" & LR).AutoFilter Field:=1, Criteria1:="WAHR" Sheets.Add After:=Sheets(Sheets.Count) .Columns("A:B").Copy ActiveSheet.Columns("A") .Columns("D").Delete Shift:=xlToLeft End With End Sub

Sub Makro3() With Sheets("WH25") .[D1:D65536] = "=RIGHT(RC[-3])=""P""" .[A1].CurrentRegion.AutoFilter Field:=4, Criteria1:="WAHR" Sheets.Add After:=Sheets(Sheets.Count) .[A:C].Copy ActiveSheet.[A:A] .[D:D].ClearContents End With End Sub

Sub Löschen() Dim TB, EZ As Integer, Sp As Integer, LR As Double, i As Double Set TB = Sheets("Tabelle1") Sp = 1 'Spalte A EZ = 2 'wegen Überschrift LR = TB.Cells(TB.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte For i = LR To EZ Step -1 If TB.Cells(i, Sp) = "" Or Right(TB.Cells(i, Sp), 1) <> "P" Then Rows(i).Delete xlUp Next End Sub

es gibt noch eine 5. Variante, diese wäre mein Favorit, weil sie
- auch bei großen Datenmengen sehr schnell ist
- einfach an unterschiedliche Löschbeingungen angepasst werden kann
- ohne Makro verwendbar ist (z.b. zum Testen)
- einach zu programmieren ist (keine Schleifen, keine Variablen)
1. kennzeichne alle Zeilen, die gelöscht werden sollen, in einer Hilfsspalte per Formel mit 0 und die die stehenbleiben müssen, mit der Zeilennummer: =Wenn(Rechts(A1;1)="P";Zeile();0)
2. schreibe in die überschriftenzeile der Hilfsspalte die 0
3. wende auf die ganze Tabelle die Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN an.
4. lösche die Hilfsspalte wieder.
Per Makro mi automatsicher Anpassung an die Größe der Tabelle:

With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(Right(RC1,1)=""P"",Row(),0)"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlno
.ClearContents
End with
End with

das ist einfach, schnell, sehr leicht an andere Bedingungen anzupassen (über die Formel) und man kannes zum Testen auch ohne VBA verwenden.
meiner Meinung nach die beste Variante zum Löschen von Zeilen mit Bedingung.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread